X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=ecmalisp.lisp;h=c060ffb4ef5b8b3044362c8022669d9f680511bb;hb=d61e7afecb594002dcb449a7d07523270b0917a7;hp=be51b2d68de9bddbf2c9feac0d85930e15e7e8fe;hpb=b373038d138b8cf9e418636e338383130c225cdd;p=jscl.git

diff --git a/ecmalisp.lisp b/ecmalisp.lisp
index be51b2d..c060ffb 100644
--- a/ecmalisp.lisp
+++ b/ecmalisp.lisp
@@ -1,6 +1,6 @@
 ;;; ecmalisp.lisp ---
 
-;; Copyright (C) 2012 David Vazquez
+;; Copyright (C) 2012, 2013 David Vazquez
 ;; Copyright (C) 2012 Raimon Grau
 
 ;; This program is free software: you can redistribute it and/or
@@ -55,7 +55,7 @@
        (eval-when-compile
          (%compile-defun ',name))
        (fsetq ,name (named-lambda ,(symbol-name name) ,args
-                      ,@body))))
+                      (block ,name ,@body)))))
 
   (defmacro defun (name args &rest body)
     `(%defun ,name ,args ,@body))
@@ -71,6 +71,12 @@
  (defun null (x)
    (eq x nil))
 
+ (defmacro return (&optional value)
+   `(return-from nil ,value))
+
+ (defmacro while (condition &body body)
+   `(block nil (%while ,condition ,@body)))
+
  (defun internp (name)
    (in name *package*))
 
@@ -147,7 +153,8 @@
         (while ,g!list
           (setq ,var (car ,g!list))
           ,@body
-          (setq ,g!list (cdr ,g!list))))))
+          (setq ,g!list (cdr ,g!list)))
+        ,(third iter))))
 
  (defmacro dotimes (iter &body body)
    (let ((g!to (gensym))
@@ -177,7 +184,7 @@
           ,@(mapcar (lambda (clausule)
                       (if (eq (car clausule) t)
                           clausule
-                          `((eql ,!form ,(car clausule))
+                          `((eql ,!form ',(car clausule))
                             ,@(cdr clausule))))
                     clausules)))))
 
@@ -377,23 +384,20 @@
 
   (defun every (function seq)
     ;; string
-    (let ((ret t)
-          (index 0)
+    (let ((index 0)
           (size (length seq)))
-      (while (and ret (< index size))
+      (while (< index size)
         (unless (funcall function (char seq index))
-          (setq ret nil))
+          (return-from every nil))
         (incf index))
-      ret))
+      t))
 
   (defun assoc (x alist)
-    (cond
-      ((null alist)
-       nil)
-      ((eql x (caar alist))
-       (car alist))
-      (t
-       (assoc x (cdr alist)))))
+    (while alist
+      (if (eql x (caar alist))
+          (return)
+          (setq alist (cdr alist))))
+    (car alist))
 
   (defun string= (s1 s2)
     (equal s1 s2)))
@@ -450,7 +454,7 @@
 
 ;;; Like CONCAT, but prefix each line with four spaces.
 (defun indent (&rest string)
-  (let ((input (!reduce #'concat string "")))
+  (let ((input (join string)))
     (let ((output "")
           (index 0)
           (size (length input)))
@@ -510,7 +514,8 @@
     x)
 
   (defun print (x)
-    (write-line (print-to-string x))))
+    (write-line (print-to-string x))
+    x))
 
 
 ;;;; Reader
@@ -663,9 +668,6 @@
 
 (defvar *compilation-unit-checks* '())
 
-(defvar *env* '())
-(defvar *fenv* '())
-
 (defun make-binding (name type js declared)
   (list name type js declared))
 
@@ -677,18 +679,52 @@
 (defun mark-binding-as-declared (b)
   (setcar (cdddr b) t))
 
+(defun make-lexenv ()
+  (list nil nil nil))
+
+(defun copy-lexenv (lexenv)
+  (copy-list lexenv))
+
+(defun push-to-lexenv (binding lexenv namespace)
+  (ecase namespace
+    (variable
+     (setcar lexenv (cons binding (car lexenv))))
+    (function
+     (setcar (cdr lexenv) (cons binding (cadr lexenv))))
+    (block
+     (setcar (cddr lexenv) (cons binding (caddr lexenv))))))
+
+(defun extend-lexenv (binding lexenv namespace)
+  (let ((env (copy-lexenv lexenv)))
+    (push-to-lexenv binding env namespace)
+    env))
+
+(defun lookup-in-lexenv (name lexenv namespace)
+  (assoc name (ecase namespace
+                (variable (first lexenv))
+                (function (second lexenv))
+                (block (third lexenv)))))
+
+(defvar *environment* (make-lexenv))
+
+(defun clear-undeclared-global-bindings ()
+  (let ((variables (first *environment*))
+        (functions (second *environment*)))
+    (setq *environment* (list variables functions (third *environment*)))))
+
+
 (defvar *variable-counter* 0)
 (defun gvarname (symbol)
   (concat "v" (integer-to-string (incf *variable-counter*))))
 
 (defun lookup-variable (symbol env)
-  (or (assoc symbol env)
-      (assoc symbol *env*)
+  (or (lookup-in-lexenv symbol env 'variable)
+      (lookup-in-lexenv symbol *environment* 'variable)
       (let ((name (symbol-name symbol))
             (binding (make-binding symbol 'variable (gvarname symbol) nil)))
-        (push binding *env*)
+        (push-to-lexenv binding *environment* 'variable)
         (push (lambda ()
-                (unless (binding-declared (assoc symbol *env*))
+                (unless (lookup-in-lexenv symbol *environment* 'variable)
                   (error (concat "Undefined variable `" name "'"))))
               *compilation-unit-checks*)
         binding)))
@@ -697,24 +733,24 @@
   (binding-translation (lookup-variable symbol env)))
 
 (defun extend-local-env (args env)
-  (append (mapcar (lambda (symbol)
-                    (make-binding symbol 'variable (gvarname symbol) t))
-                  args)
-          env))
+  (let ((new (copy-lexenv env)))
+    (dolist (symbol args new)
+      (let ((b (make-binding symbol 'variable (gvarname symbol) t)))
+        (push-to-lexenv b new 'variable)))))
 
 (defvar *function-counter* 0)
 (defun lookup-function (symbol env)
-  (or (assoc symbol env)
-      (assoc symbol *fenv*)
+  (or (lookup-in-lexenv symbol env 'function)
+      (lookup-in-lexenv symbol *environment* 'function)
       (let ((name (symbol-name symbol))
             (binding
              (make-binding symbol
                            'function
                            (concat "f" (integer-to-string (incf *function-counter*)))
                            nil)))
-        (push binding *fenv*)
+        (push-to-lexenv binding *environment* 'function)
         (push (lambda ()
-                (unless (binding-declared (assoc symbol *fenv*))
+                (unless (binding-declared (lookup-in-lexenv symbol *environment* 'function))
                   (error (concat "Undefined function `" name "'"))))
               *compilation-unit-checks*)
         binding)))
@@ -725,43 +761,43 @@
 (defvar *toplevel-compilations* nil)
 
 (defun %compile-defvar (name)
-  (let ((b (lookup-variable name *env*)))
+  (let ((b (lookup-variable name *environment*)))
     (mark-binding-as-declared b)
     (push (concat "var " (binding-translation b)) *toplevel-compilations*)))
 
 (defun %compile-defun (name)
-  (let ((b (lookup-function name *fenv*)))
+  (let ((b (lookup-function name *environment*)))
     (mark-binding-as-declared b)
     (push (concat "var " (binding-translation b)) *toplevel-compilations*)))
 
 (defun %compile-defmacro (name lambda)
-  (push (make-binding name 'macro lambda t) *fenv*))
+  (push-to-lexenv (make-binding name 'macro lambda t) *environment* 'function))
 
 (defvar *compilations* nil)
 
-(defun ls-compile-block (sexps env fenv)
+(defun ls-compile-block (sexps env)
   (join-trailing
    (remove-if (lambda (x)
                 (or (null x)
                     (and (stringp x)
                          (zerop (length x)))))
-              (mapcar (lambda (x) (ls-compile x env fenv))  sexps))
+              (mapcar (lambda (x) (ls-compile x env))  sexps))
    (concat ";" *newline*)))
 
 (defmacro define-compilation (name args &body body)
   ;; Creates a new primitive `name' with parameters args and
   ;; @body. The body can access to the local environment through the
   ;; variable ENV.
-  `(push (list ',name (lambda (env fenv ,@args) ,@body))
+  `(push (list ',name (lambda (env ,@args) ,@body))
          *compilations*))
 
 (define-compilation if (condition true false)
   (concat "("
-          (ls-compile condition env fenv) " !== " (ls-compile nil nil nil)
+          (ls-compile condition env) " !== " (ls-compile nil)
           " ? "
-          (ls-compile true env fenv)
+          (ls-compile true env)
           " : "
-          (ls-compile false env fenv)
+          (ls-compile false env)
           ")"))
 
 
@@ -829,7 +865,7 @@
                                                  (integer-to-string (+ idx n-required-arguments)) ":" *newline*
                                                  (lookup-variable-translation (car arg) new-env)
                                                  "="
-                                                 (ls-compile (cadr arg) new-env fenv)
+                                                 (ls-compile (cadr arg) new-env)
                                                  ";" *newline*)
                                          cases)
                                    (incf idx)))
@@ -840,7 +876,7 @@
                ;; &rest/&body argument
                (if rest-argument
                    (let ((js!rest (lookup-variable-translation rest-argument new-env)))
-                     (concat "var " js!rest "= " (ls-compile nil env fenv) ";" *newline*
+                     (concat "var " js!rest "= " (ls-compile nil) ";" *newline*
                              "for (var i = arguments.length-1; i>="
                              (integer-to-string (+ n-required-arguments n-optional-arguments))
                              "; i--)" *newline*
@@ -849,19 +885,19 @@
                                      *newline*))
                    "")
                ;; Body
-               (concat (ls-compile-block (butlast body) new-env fenv)
-                       "return " (ls-compile (car (last body)) new-env fenv) ";")) *newline*
+               (concat (ls-compile-block (butlast body) new-env)
+                       "return " (ls-compile (car (last body)) new-env) ";")) *newline*
               "})"))))
 
 (define-compilation fsetq (var val)
-  (concat (lookup-function-translation var fenv)
+  (concat (lookup-function-translation var env)
           " = "
-          (ls-compile val env fenv)))
+          (ls-compile val env)))
 
 (define-compilation setq (var val)
   (concat (lookup-variable-translation var env)
           " = "
-           (ls-compile val env fenv)))
+           (ls-compile val env)))
 
 ;;; Literals
 (defun escape-string (string)
@@ -883,7 +919,7 @@
   (cond
     ((integerp sexp) (integer-to-string sexp))
     ((stringp sexp) (concat "\"" (escape-string sexp) "\""))
-    ((symbolp sexp) (ls-compile `(intern ,(escape-string (symbol-name sexp))) *env* *fenv*))
+    ((symbolp sexp) (ls-compile `(intern ,(escape-string (symbol-name sexp))) *environment*))
     ((consp sexp) (concat "{car: "
                           (literal->js (car sexp))
                           ", cdr: "
@@ -898,21 +934,20 @@
 (define-compilation quote (sexp)
   (literal sexp))
 
-(define-compilation while (pred &rest body)
+(define-compilation %while (pred &rest body)
   (concat "(function(){" *newline*
-          (indent "while("
-                  (ls-compile pred env fenv)
-                  " !== "
-                  (ls-compile nil nil nil) "){" *newline*
-                  (indent (ls-compile-block body env fenv)))
-          "}})()"))
+          (indent "while(" (ls-compile pred env) " !== " (ls-compile nil) "){" *newline*
+                  (indent (ls-compile-block body env))
+                  "}"
+                  "return " (ls-compile nil) ";" *newline*)
+          "})()"))
 
 (define-compilation function (x)
   (cond
     ((and (listp x) (eq (car x) 'lambda))
-     (ls-compile x env fenv))
+     (ls-compile x env))
     ((symbolp x)
-     (lookup-function-translation x fenv))))
+     (lookup-function-translation x env))))
 
 (define-compilation eval-when-compile (&rest body)
   (eval (cons 'progn body))
@@ -920,12 +955,12 @@
 
 (defmacro define-transformation (name args form)
   `(define-compilation ,name ,args
-     (ls-compile ,form env fenv)))
+     (ls-compile ,form env)))
 
 (define-compilation progn (&rest body)
   (concat "(function(){" *newline*
-          (indent (ls-compile-block (butlast body) env fenv)
-                  "return " (ls-compile (car (last body)) env fenv) ";" *newline*)
+          (indent (ls-compile-block (butlast body) env)
+                  "return " (ls-compile (car (last body)) env) ";" *newline*)
           "})()"))
 
 (define-compilation let (bindings &rest body)
@@ -939,14 +974,44 @@
                               variables)
                       ",")
                 "){" *newline*
-                (indent (ls-compile-block (butlast body) new-env fenv)
-                        "return " (ls-compile (car (last body)) new-env fenv)
+                (indent (ls-compile-block (butlast body) new-env)
+                        "return " (ls-compile (car (last body)) new-env)
                         ";" *newline*)
-                "})(" (join (mapcar (lambda (x) (ls-compile x env fenv))
+                "})(" (join (mapcar (lambda (x) (ls-compile x env))
                                     values)
                             ",")
                 ")")))))
 
+
+(defvar *block-counter* 0)
+
+(define-compilation block (name &rest body)
+  (let ((tr (integer-to-string (incf *block-counter*))))
+    (let ((b (make-binding name 'block tr t)))
+      (concat "(function(){" *newline*
+              (indent "try {" *newline*
+                      (indent "return " (ls-compile `(progn ,@body)
+                                                    (extend-lexenv b env 'block))) ";" *newline*
+                      "}" *newline*
+                      "catch (cf){" *newline*
+                      "    if (cf.type == 'block' && cf.id == " tr ")" *newline*
+                      "        return cf.value;" *newline*
+                      "    else" *newline*
+                      "        throw cf;" *newline*
+                      "}" *newline*)
+              "})()"))))
+
+(define-compilation return-from (name &optional value)
+  (let ((b (lookup-in-lexenv name env 'block)))
+    (if b
+        (concat "(function(){ throw ({"
+                "type: 'block', "
+                "id: " (binding-translation b) ", "
+                "value: " (ls-compile value env) ", "
+                "message: 'Return from unknown block " (symbol-name name) ".'"
+                "})})()")
+        (error (concat "Unknown block `" (symbol-name name) "'.")))))
+
 ;;; A little backquote implementation without optimizations of any
 ;;; kind for ecmalisp.
 (defun backquote-expand-1 (form)
@@ -986,11 +1051,11 @@
 
 (defmacro define-builtin (name args &body body)
   `(define-compilation ,name ,args
-     (let ,(mapcar (lambda (arg) `(,arg (ls-compile ,arg env fenv))) args)
+     (let ,(mapcar (lambda (arg) `(,arg (ls-compile ,arg env))) args)
        ,@body)))
 
 (defun compile-bool (x)
-  (concat "(" x "?" (ls-compile t nil nil) ": " (ls-compile nil nil nil) ")"))
+  (concat "(" x "?" (ls-compile t) ": " (ls-compile nil) ")"))
 
 ;;; DECLS is a list of (JSVARNAME TYPE LISPFORM) declarations.
 (defmacro type-check (decls &body body)
@@ -1046,16 +1111,16 @@
 (define-builtin car (x)
   (concat "(function(){" *newline*
           (indent "var tmp = " x ";" *newline*
-                  "return tmp === " (ls-compile nil nil nil)
-                  "? " (ls-compile nil nil nil)
+                  "return tmp === " (ls-compile nil)
+                  "? " (ls-compile nil)
                   ": tmp.car;" *newline*)
           "})()"))
 
 (define-builtin cdr (x)
   (concat "(function(){" *newline*
           (indent "var tmp = " x ";" *newline*
-                  "return tmp === " (ls-compile nil nil nil) "? "
-                  (ls-compile nil nil nil)
+                  "return tmp === " (ls-compile nil) "? "
+                  (ls-compile nil)
                   ": tmp.cdr;" *newline*)
           "})()"))
 
@@ -1101,11 +1166,11 @@
 
 (define-compilation slice (string a &optional b)
   (concat "(function(){" *newline*
-          (indent "var str = " (ls-compile string env fenv) ";" *newline*
-                  "var a = " (ls-compile a env fenv) ";" *newline*
+          (indent "var str = " (ls-compile string env) ";" *newline*
+                  "var a = " (ls-compile a env) ";" *newline*
                   "var b;" *newline*
                   (if b
-                      (concat "b = " (ls-compile b env fenv) ";" *newline*)
+                      (concat "b = " (ls-compile b env) ";" *newline*)
                       "")
                   "return str.slice(a,b);" *newline*)
           "})()"))
@@ -1121,27 +1186,27 @@
     "string1.concat(string2)"))
 
 (define-compilation funcall (func &rest args)
-  (concat "(" (ls-compile func env fenv) ")("
+  (concat "(" (ls-compile func env) ")("
           (join (mapcar (lambda (x)
-                          (ls-compile x env fenv))
+                          (ls-compile x env))
                         args)
                 ", ")
           ")"))
 
 (define-compilation apply (func &rest args)
   (if (null args)
-      (concat "(" (ls-compile func env fenv) ")()")
+      (concat "(" (ls-compile func env) ")()")
       (let ((args (butlast args))
             (last (car (last args))))
         (concat "(function(){" *newline*
-                (indent "var f = " (ls-compile func env fenv) ";" *newline*
+                (indent "var f = " (ls-compile func env) ";" *newline*
                         "var args = [" (join (mapcar (lambda (x)
-                                                       (ls-compile x env fenv))
+                                                       (ls-compile x env))
                                                      args)
                                              ", ")
                         "];" *newline*
-                        "var tail = (" (ls-compile last env fenv) ");" *newline*
-                        (indent "while (tail != " (ls-compile nil env fenv) "){" *newline*
+                        "var tail = (" (ls-compile last env) ");" *newline*
+                        (indent "while (tail != " (ls-compile nil) "){" *newline*
                                 "    args.push(tail.car);" *newline*
                                 "    tail = tail.cdr;" *newline*
                                 "}" *newline*
@@ -1160,7 +1225,7 @@
 (define-builtin get (object key)
   (concat "(function(){" *newline*
           (indent "var tmp = " "(" object ")[" key "];" *newline*
-                  "return tmp == undefined? " (ls-compile nil nil nil) ": tmp ;" *newline*)
+                  "return tmp == undefined? " (ls-compile nil) ": tmp ;" *newline*)
           "})()"))
 
 (define-builtin set (object key value)
@@ -1177,33 +1242,33 @@
     "lisp.write(x)"))
 
 (defun macrop (x)
-  (and (symbolp x) (eq (binding-type (lookup-function x *fenv*)) 'macro)))
+  (and (symbolp x) (eq (binding-type (lookup-function x *environment*)) 'macro)))
 
-(defun ls-macroexpand-1 (form env fenv)
+(defun ls-macroexpand-1 (form env)
   (if (macrop (car form))
-      (let ((binding (lookup-function (car form) *env*)))
+      (let ((binding (lookup-function (car form) *environment*)))
         (if (eq (binding-type binding) 'macro)
             (apply (eval (binding-translation binding)) (cdr form))
             form))
       form))
 
-(defun compile-funcall (function args env fenv)
+(defun compile-funcall (function args env)
   (cond
     ((symbolp function)
-     (concat (lookup-function-translation function fenv)
+     (concat (lookup-function-translation function env)
              "("
-             (join (mapcar (lambda (x) (ls-compile x env fenv)) args)
+             (join (mapcar (lambda (x) (ls-compile x env)) args)
                    ", ")
              ")"))
     ((and (listp function) (eq (car function) 'lambda))
-     (concat "(" (ls-compile function env fenv) ")("
-             (join (mapcar (lambda (x) (ls-compile x env fenv)) args)
+     (concat "(" (ls-compile function env) ")("
+             (join (mapcar (lambda (x) (ls-compile x env)) args)
                    ", ")
              ")"))
     (t
      (error (concat "Invalid function designator " (symbol-name function))))))
 
-(defun ls-compile (sexp env fenv)
+(defun ls-compile (sexp &optional (env (make-lexenv)))
   (cond
     ((symbolp sexp) (lookup-variable-translation sexp env))
     ((integerp sexp) (integer-to-string sexp))
@@ -1211,14 +1276,14 @@
     ((listp sexp)
      (if (assoc (car sexp) *compilations*)
          (let ((comp (second (assoc (car sexp) *compilations*))))
-           (apply comp env fenv (cdr sexp)))
+           (apply comp env (cdr sexp)))
          (if (macrop (car sexp))
-             (ls-compile (ls-macroexpand-1 sexp env fenv) env fenv)
-             (compile-funcall (car sexp) (cdr sexp) env fenv))))))
+             (ls-compile (ls-macroexpand-1 sexp env) env)
+             (compile-funcall (car sexp) (cdr sexp) env))))))
 
 (defun ls-compile-toplevel (sexp)
   (setq *toplevel-compilations* nil)
-  (let ((code (ls-compile sexp nil nil)))
+  (let ((code (ls-compile sexp)))
     (prog1
         (concat (join (mapcar (lambda (x) (concat x ";" *newline*))
                               *toplevel-compilations*))
@@ -1232,46 +1297,47 @@
 
 #+ecmalisp
 (progn
- (defmacro with-compilation-unit (&body body)
-   `(prog1
-        (progn
-          (setq *compilation-unit-checks* nil)
-          (setq *env* (remove-if-not #'binding-declared *env*))
-          (setq *fenv* (remove-if-not #'binding-declared *fenv*))
-          ,@body)
-      (dolist (check *compilation-unit-checks*)
-        (funcall check))))
-
- (defun eval (x)
-   (let ((code
-          (with-compilation-unit
-              (ls-compile-toplevel x))))
-     (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
-   (let ((c1 (ls-compile `(setq *fenv* ',*fenv*) nil nil))
-         (c2 (ls-compile `(setq *env* ',*env*) nil nil))
-         (c3 (ls-compile `(setq *variable-counter* ',*variable-counter*) nil nil))
-         (c4 (ls-compile `(setq *function-counter* ',*function-counter*) nil nil))
-         (c5 (ls-compile `(setq *literal-counter* ',*literal-counter*) nil nil))
-         (c6 (ls-compile `(setq *gensym-counter* ',*gensym-counter*) nil nil)))
-     (setq *toplevel-compilations*
-           (append *toplevel-compilations* (list c1 c2 c3 c4 c5 c6)))))
-
- (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.eval(lisp.read(str));" *newline*
-          "}" *newline*
-          "lisp.compileString = function(str){" *newline*
-          "   return lisp.compile(lisp.read(str));" *newline*
-          "}" *newline*)))
+  (defmacro with-compilation-unit (&body body)
+    `(prog1
+         (progn
+           (setq *compilation-unit-checks* nil)
+           (clear-undeclared-global-bindings)
+           ,@body)
+       (dolist (check *compilation-unit-checks*)
+         (funcall check))))
+
+  (defun eval (x)
+    (let ((code
+           (with-compilation-unit
+               (ls-compile-toplevel x))))
+      (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
+    (let ((tmp (ls-compile
+                `(progn
+                   (setq *environment* ',*environment*)
+                   (setq *variable-counter* ',*variable-counter*)
+                   (setq *function-counter* ',*function-counter*)
+                   (setq *literal-counter* ',*literal-counter*)
+                   (setq *gensym-counter* ',*gensym-counter*)
+                   (setq *block-counter* ',*block-counter*)))))
+      (setq *toplevel-compilations*
+            (append *toplevel-compilations* (list tmp)))))
+
+  (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.eval(lisp.read(str));" *newline*
+           "}" *newline*
+           "lisp.compileString = function(str){" *newline*
+           "   return lisp.compile(lisp.read(str));" *newline*
+           "}" *newline*)))
 
 
 ;;; Finally, we provide a couple of functions to easily bootstrap
@@ -1286,7 +1352,6 @@
         seq)))
 
   (defun ls-compile-file (filename output)
-    (setq *env* nil *fenv* nil)
     (setq *compilation-unit-checks* nil)
     (with-open-file (out output :direction :output :if-exists :supersede)
       (let* ((source (read-whole-file filename))
@@ -1302,8 +1367,10 @@
         (setq *compilation-unit-checks* nil))))
 
   (defun bootstrap ()
+    (setq *environment* (make-lexenv))
     (setq *variable-counter* 0
           *gensym-counter* 0
           *function-counter* 0
-          *literal-counter* 0)
+          *literal-counter* 0
+          *block-counter* 0)
     (ls-compile-file "ecmalisp.lisp" "ecmalisp.js")))