lispstrack.lisp

   1 (defun ensure-list (x)
   2   (if (listp x)
   3       x
   4       (list x)))
   5
   6 (defun !reduce (func list initial)
   7   (if (null list)
   8       initial
   9       (!reduce func
  10                (cdr list)
  11                (funcall func initial (car list)))))
  12
  13 ;;; Utils
  14
  15 #+common-lisp
  16 (progn
  17   (defmacro while (condition &body body)
  18     `(do ()
  19          ((not ,condition))
  20        ,@body))
  21
  22   (defun concat-two (s1 s2)
  23     (concatenate 'string s1 s2))
  24
  25   (defun setcar (cons new)
  26     (setf (car cons) new))
  27   (defun setcdr (cons new)
  28     (setf (cdr cons) new)))
  29
  30 (defvar *newline* (string (code-char 10)))
  31
  32 (defun concat (&rest strs)
  33   (!reduce (lambda (s1 s2) (concat-two s1 s2))
  34            strs
  35            ""))
  36
  37 ;;; Concatenate a list of strings, with a separator
  38 (defun join (list separator)
  39   (cond
  40     ((null list)
  41      "")
  42     ((null (cdr list))
  43      (car list))
  44     (t
  45      (concat (car list)
  46              separator
  47              (join (cdr list) separator)))))
  48
  49 (defun join-trailing (list separator)
  50   (cond
  51     ((null list)
  52      "")
  53     ((null (car list))
  54      (join-trailing (cdr list) separator))
  55     (t
  56      (concat (car list) separator (join-trailing (cdr list) separator)))))
  57
  58 (defun integer-to-string (x)
  59   (if (zerop x)
  60       "0"
  61       (let ((digits nil))
  62         (while (not (= x 0))
  63           (push (mod x 10) digits)
  64           (setq x (truncate x 10)))
  65         (join (mapcar (lambda (d) (string (char "0123456789" d)))
  66                       digits)
  67               ""))))
  68
  69 ;;;; Reader
  70
  71 ;;; It is a basic Lisp reader. It does not use advanced stuff
  72 ;;; intentionally, because we want to use it to bootstrap a simple
  73 ;;; Lisp. The main entry point is the function `ls-read', which
  74 ;;; accepts a strings as argument and return the Lisp expression.
  75 (defun make-string-stream (string)
  76   (cons string 0))
  77
  78 (defun %peek-char (stream)
  79   (and (< (cdr stream) (length (car stream)))
  80        (char (car stream) (cdr stream))))
  81
  82 (defun %read-char (stream)
  83   (and (< (cdr stream) (length (car stream)))
  84        (prog1 (char (car stream) (cdr stream))
  85          (setcdr stream (1+ (cdr stream))))))
  86
  87 (defun whitespacep (ch)
  88   (or (char= ch #\space) (char= ch #\newline) (char= ch #\tab)))
  89
  90 (defun skip-whitespaces (stream)
  91   (let (ch)
  92     (setq ch (%peek-char stream))
  93     (while (and ch (whitespacep ch))
  94       (%read-char stream)
  95       (setq ch (%peek-char stream)))))
  96
  97 (defun terminalp (ch)
  98   (or (null ch) (whitespacep ch) (char= #\) ch) (char= #\( ch)))
  99
 100 (defun read-until (stream func)
 101   (let ((string "")
 102         (ch))
 103     (setq ch (%peek-char stream))
 104     (while (not (funcall func ch))
 105       (setq string (concat string (string ch)))
 106       (%read-char stream)
 107       (setq ch (%peek-char stream)))
 108     string))
 109
 110 (defun skip-whitespaces-and-comments (stream)
 111   (let (ch)
 112     (skip-whitespaces stream)
 113     (setq ch (%peek-char stream))
 114     (while (and ch (char= ch #\;))
 115       (read-until stream (lambda (x) (char= x #\newline)))
 116       (skip-whitespaces stream)
 117       (setq ch (%peek-char stream)))))
 118
 119 (defun %read-list (stream)
 120   (skip-whitespaces-and-comments stream)
 121   (let ((ch (%peek-char stream)))
 122     (cond
 123       ((char= ch #\))
 124        (%read-char stream)
 125        nil)
 126       ((char= ch #\.)
 127        (%read-char stream)
 128        (skip-whitespaces-and-comments stream)
 129        (prog1 (ls-read stream)
 130          (unless (char= (%read-char stream) #\))
 131            (error "')' was expected."))))
 132       (t
 133        (cons (ls-read stream) (%read-list stream))))))
 134
 135 (defun read-string (stream)
 136   (let ((string "")
 137         (ch nil))
 138     (setq ch (%read-char stream))
 139     (while (not (char= ch #\"))
 140       (when (char= ch #\\)
 141         (setq ch (%read-char stream)))
 142       (setq string (concat string (string ch)))
 143       (setq ch (%read-char stream)))
 144     string))
 145
 146 (defvar *eof* (make-symbol "EOF"))
 147 (defun ls-read (stream)
 148   (skip-whitespaces-and-comments stream)
 149   (let ((ch (%peek-char stream)))
 150     (cond
 151       ((null ch)
 152        *eof*)
 153       ((char= ch #\()
 154        (%read-char stream)
 155        (%read-list stream))
 156       ((char= ch #\')
 157        (%read-char stream)
 158        (list 'quote (ls-read stream)))
 159       ((char= ch #\`)
 160        (%read-char stream)
 161        (list 'backquote (ls-read stream)))
 162       ((char= ch #\")
 163        (%read-char stream)
 164        (read-string stream))
 165       ((char= ch #\,)
 166        (%read-char stream)
 167        (if (eql (%peek-char stream) #\@)
 168            (progn (%read-char stream) (list 'unquote-splicing (ls-read stream)))
 169            (list 'unquote (ls-read stream))))
 170       ((char= ch #\#)
 171        (%read-char stream)
 172        (ecase (%read-char stream)
 173          (#\'
 174           (list 'function (ls-read stream)))
 175          (#\\
 176           (let ((cname
 177                  (concat (string (%read-char stream))
 178                          (read-until stream #'terminalp))))
 179             (cond
 180               ((string= cname "space") (char-code #\space))
 181               ((string= cname "tab") (char-code #\tab))
 182               ((string= cname "newline") (char-code #\newline))
 183               (t (char-code (char cname 0))))))
 184          (#\+
 185           (let ((feature (read-until stream #'terminalp)))
 186             (cond
 187               ((string= feature "common-lisp")
 188                (ls-read stream)         ;ignore
 189                (ls-read stream))
 190               ((string= feature "lispstrack")
 191                (ls-read stream))
 192               (t
 193                (error "Unknown reader form.")))))))
 194       (t
 195        (let ((string (read-until stream #'terminalp)))
 196          (if (every #'digit-char-p string)
 197              (parse-integer string)
 198              (intern (string-upcase string))))))))
 199
 200 (defun ls-read-from-string (string)
 201   (ls-read (make-string-stream string)))
 202
 203
 204 ;;;; Compiler
 205
 206 (defvar *compilation-unit-checks* '())
 207
 208 (defvar *env* '())
 209 (defvar *fenv* '())
 210
 211 (defun make-binding (name type js declared)
 212   (list name type js declared))
 213
 214 (defun binding-name (b) (first b))
 215 (defun binding-type (b) (second b))
 216 (defun binding-translation (b) (third b))
 217 (defun binding-declared (b)
 218   (and b (fourth b)))
 219 (defun mark-binding-as-declared (b)
 220   (setcar (cdddr b) t))
 221
 222 (let ((counter 0))
 223   (defun gvarname (symbol)
 224     (concat "v" (integer-to-string (incf counter))))
 225
 226   (defun lookup-variable (symbol env)
 227     (or (assoc symbol env)
 228         (assoc symbol *env*)
 229         (let ((name (symbol-name symbol))
 230               (binding (make-binding symbol 'variable (gvarname symbol) nil)))
 231           (push binding *env*)
 232           (push (lambda ()
 233                   (unless (binding-declared (assoc symbol *env*))
 234                     (error (concat "Undefined variable `" name "'"))))
 235                 *compilation-unit-checks*)
 236           binding)))
 237
 238   (defun lookup-variable-translation (symbol env)
 239     (binding-translation (lookup-variable symbol env)))
 240
 241   (defun extend-local-env (args env)
 242     (append (mapcar (lambda (symbol)
 243                       (make-binding symbol 'variable (gvarname symbol) t))
 244                     args)
 245             env)))
 246
 247 (let ((counter 0))
 248   (defun lookup-function (symbol env)
 249     (or (assoc symbol env)
 250         (assoc symbol *fenv*)
 251         (let ((name (symbol-name symbol))
 252               (binding
 253                (make-binding symbol
 254                              'function
 255                              (concat "f" (integer-to-string (incf counter)))
 256                              nil)))
 257           (push binding *fenv*)
 258           (push (lambda ()
 259                   (unless (binding-declared (assoc symbol *fenv*))
 260                     (error (concat "Undefined function `" name "'"))))
 261                 *compilation-unit-checks*)
 262           binding)))
 263
 264   (defun lookup-function-translation (symbol env)
 265     (binding-translation (lookup-function symbol env))))
 266
 267
 268 (defvar *toplevel-compilations* nil)
 269
 270 (defun %compile-defvar (name)
 271   (let ((b (lookup-variable name *env*)))
 272     (mark-binding-as-declared b)
 273     (push (concat "var " (binding-translation b)) *toplevel-compilations*)))
 274
 275 (defun %compile-defun (name)
 276   (let ((b (lookup-function name *env*)))
 277     (mark-binding-as-declared b)
 278     (push (concat "var " (binding-translation b)) *toplevel-compilations*)))
 279
 280 (defun %compile-defmacro (name lambda)
 281   (push (make-binding name 'macro lambda t) *fenv*))
 282
 283
 284 (defvar *compilations* nil)
 285
 286 (defun ls-compile-block (sexps env fenv)
 287   (join-trailing
 288    (remove nil (mapcar (lambda (x)
 289                          (ls-compile x env fenv))
 290                        sexps))
 291                  ";
 292 "))
 293 (defmacro define-compilation (name args &rest body)
 294   ;; Creates a new primitive `name' with parameters args and
 295   ;; @body. The body can access to the local environment through the
 296   ;; variable ENV.
 297   `(push (list ',name (lambda (env fenv ,@args) ,@body))
 298          *compilations*))
 299
 300 (define-compilation if (condition true false)
 301   (concat "("
 302           (ls-compile condition env fenv)
 303           " ? "
 304           (ls-compile true env fenv)
 305           " : "
 306           (ls-compile false env fenv)
 307           ")"))
 308
 309 ;;; Return the required args of a lambda list
 310 (defun lambda-list-required-argument (lambda-list)
 311   (if (or (null lambda-list) (eq (car lambda-list) '&rest))
 312       nil
 313       (cons (car lambda-list) (lambda-list-required-argument (cdr lambda-list)))))
 314
 315 (defun lambda-list-rest-argument (lambda-list)
 316   (second (member '&rest lambda-list)))
 317
 318 (define-compilation lambda (lambda-list &rest body)
 319   (let ((required-arguments (lambda-list-required-argument lambda-list))
 320         (rest-argument (lambda-list-rest-argument lambda-list)))
 321     (let ((new-env (extend-local-env
 322                     (append (and rest-argument (list rest-argument))
 323                             required-arguments)
 324                     env)))
 325       (concat "(function ("
 326               (join (mapcar (lambda (x)
 327                               (lookup-variable-translation x new-env))
 328                             required-arguments)
 329                     ",")
 330               "){"
 331               *newline*
 332               (if rest-argument
 333                   (let ((js!rest (lookup-variable-translation rest-argument new-env)))
 334                     (concat "var " js!rest "= false;" *newline*
 335                             "for (var i = arguments.length-1; i>="
 336                             (integer-to-string (length required-arguments))
 337                             "; i--)" *newline*
 338                             js!rest " = "
 339                             "{car: arguments[i], cdr: " js!rest "};"
 340                             *newline*))
 341                   "")
 342               (concat (ls-compile-block (butlast body) new-env fenv)
 343                       "return " (ls-compile (car (last body)) new-env fenv) ";")
 344               *newline*
 345               "})"))))
 346
 347 (define-compilation fsetq (var val)
 348   (concat (lookup-function-translation var fenv)
 349           " = "
 350           (ls-compile val env fenv)))
 351
 352 (define-compilation setq (var val)
 353   (concat (lookup-variable-translation var env)
 354           " = "
 355            (ls-compile val env fenv)))
 356
 357 ;;; Literals
 358
 359 (defun escape-string (string)
 360   (let ((output "")
 361         (index 0)
 362         (size (length string)))
 363     (while (< index size)
 364       (let ((ch (char string index)))
 365         (when (or (char= ch #\") (char= ch #\\))
 366           (setq output (concat output "\\")))
 367         (when (or (char= ch #\newline))
 368           (setq output (concat output "\\"))
 369           (setq ch #\n))
 370         (setq output (concat output (string ch))))
 371       (incf index))
 372     output))
 373
 374 (defun literal->js (sexp)
 375   (cond
 376     ((null sexp) "false")
 377     ((integerp sexp) (integer-to-string sexp))
 378     ((stringp sexp) (concat "\"" (escape-string sexp) "\""))
 379     ((symbolp sexp) (ls-compile `(intern ,(escape-string (symbol-name sexp))) *env* *fenv*))
 380     ((consp sexp) (concat "{car: "
 381                           (literal->js (car sexp))
 382                           ", cdr: "
 383                           (literal->js (cdr sexp)) "}"))))
 384
 385 (let ((counter 0))
 386   (defun literal (form)
 387     (let ((var (concat "l" (integer-to-string (incf counter)))))
 388       (push (concat "var " var " = " (literal->js form)) *toplevel-compilations*)
 389       var)))
 390
 391 (define-compilation quote (sexp)
 392   (literal sexp))
 393
 394 (define-compilation debug (form)
 395   (concat "console.log(" (ls-compile form env fenv) ")"))
 396
 397 (define-compilation while (pred &rest body)
 398   (concat "(function(){ while("
 399           (ls-compile pred env fenv)
 400           "){"
 401           (ls-compile-block body env fenv)
 402           "}})()"))
 403
 404 (define-compilation function (x)
 405   (cond
 406     ((and (listp x) (eq (car x) 'lambda))
 407      (ls-compile x env fenv))
 408     ((symbolp x)
 409      (lookup-function-translation x fenv))))
 410
 411 #+common-lisp
 412 (defmacro eval-when-compile (&body body)
 413   `(eval-when (:compile-toplevel :load-toplevel :execute)
 414      ,@body))
 415
 416 (define-compilation eval-when-compile (&rest body)
 417   (eval (cons 'progn body))
 418   nil)
 419
 420 (defmacro define-transformation (name args form)
 421   `(define-compilation ,name ,args
 422      (ls-compile ,form env fenv)))
 423
 424 (define-transformation progn (&rest body)
 425   `((lambda () ,@body)))
 426
 427 (define-transformation let (bindings &rest body)
 428   (let ((bindings (mapcar #'ensure-list bindings)))
 429     `((lambda ,(mapcar 'car bindings) ,@body)
 430       ,@(mapcar 'cadr bindings))))
 431
 432 ;;; A little backquote implementation without optimizations of any
 433 ;;; kind for lispstrack.
 434 (defun backquote-expand-1 (form)
 435   (cond
 436     ((symbolp form)
 437      (list 'quote form))
 438     ((atom form)
 439      form)
 440     ((eq (car form) 'unquote)
 441      (car form))
 442     ((eq (car form) 'backquote)
 443      (backquote-expand-1 (backquote-expand-1 (cadr form))))
 444     (t
 445      (cons 'append
 446            (mapcar (lambda (s)
 447                      (cond
 448                        ((and (listp s) (eq (car s) 'unquote))
 449                         (list 'list (cadr s)))
 450                        ((and (listp s) (eq (car s) 'unquote-splicing))
 451                         (cadr s))
 452                        (t
 453                         (list 'list (backquote-expand-1 s)))))
 454                    form)))))
 455
 456 (defun backquote-expand (form)
 457   (if (and (listp form) (eq (car form) 'backquote))
 458       (backquote-expand-1 (cadr form))
 459       form))
 460
 461 (defmacro backquote (form)
 462   (backquote-expand-1 form))
 463
 464 (define-transformation backquote (form)
 465   (backquote-expand-1 form))
 466
 467 ;;; Primitives
 468
 469 (define-compilation + (x y)
 470   (concat "((" (ls-compile x env fenv) ") + (" (ls-compile y env fenv) "))"))
 471
 472 (define-compilation - (x y)
 473   (concat "((" (ls-compile x env fenv) ") - (" (ls-compile y env fenv) "))"))
 474
 475 (define-compilation * (x y)
 476   (concat "((" (ls-compile x env fenv) ") * (" (ls-compile y env fenv) "))"))
 477
 478 (define-compilation / (x y)
 479   (concat "((" (ls-compile x env fenv) ") / (" (ls-compile y env fenv) "))"))
 480
 481 (define-compilation < (x y)
 482   (concat "((" (ls-compile x env fenv) ") < (" (ls-compile y env fenv) "))"))
 483
 484 (define-compilation = (x y)
 485   (concat "((" (ls-compile x env fenv) ") == (" (ls-compile y env fenv) "))"))
 486
 487 (define-compilation numberp (x)
 488   (concat "(typeof (" (ls-compile x env fenv) ") == \"number\")"))
 489
 490
 491 (define-compilation mod (x y)
 492   (concat "((" (ls-compile x env fenv) ") % (" (ls-compile y env fenv) "))"))
 493
 494 (define-compilation floor (x)
 495   (concat "(Math.floor(" (ls-compile x env fenv) "))"))
 496
 497 (define-compilation null (x)
 498   (concat "(" (ls-compile x env fenv) "== false)"))
 499
 500 (define-compilation cons (x y)
 501   (concat "{car: " (ls-compile x env fenv) ", cdr: " (ls-compile y env fenv) "}"))
 502
 503 (define-compilation consp (x)
 504   (concat "(function(){ var tmp = "
 505           (ls-compile x env fenv)
 506           "; return (typeof tmp == 'object' && 'car' in tmp);})()"))
 507
 508 (define-compilation car (x)
 509   (concat "(" (ls-compile x env fenv) ").car"))
 510
 511 (define-compilation cdr (x)
 512   (concat "(" (ls-compile x env fenv) ").cdr"))
 513
 514 (define-compilation setcar (x new)
 515   (concat "((" (ls-compile x env fenv) ").car = " (ls-compile new env fenv) ")"))
 516
 517 (define-compilation setcdr (x new)
 518   (concat "((" (ls-compile x env fenv) ").cdr = " (ls-compile new env fenv) ")"))
 519
 520 (define-compilation symbolp (x)
 521   (concat "(function(){ var tmp = "
 522           (ls-compile x env fenv)
 523           "; return (typeof tmp == 'object' && 'name' in tmp); })()"))
 524
 525 (define-compilation make-symbol (name)
 526   (concat "{name: " (ls-compile name env fenv) "}"))
 527
 528 (define-compilation symbol-name (x)
 529   (concat "(" (ls-compile x env fenv) ").name"))
 530
 531 (define-compilation eq (x y)
 532   (concat "(" (ls-compile x env fenv) " === " (ls-compile y env fenv) ")"))
 533
 534 (define-compilation equal (x y)
 535   (concat "(" (ls-compile x env fenv) " == " (ls-compile y env fenv) ")"))
 536
 537 (define-compilation string (x)
 538   (concat "String.fromCharCode(" (ls-compile x env fenv) ")"))
 539
 540 (define-compilation stringp (x)
 541   (concat "(typeof(" (ls-compile x env fenv) ") == \"string\")"))
 542
 543 (define-compilation string-upcase (x)
 544   (concat "(" (ls-compile x env fenv) ").toUpperCase()"))
 545
 546 (define-compilation string-length (x)
 547   (concat "(" (ls-compile x env fenv) ").length"))
 548
 549 (define-compilation char (string index)
 550   (concat "("
 551           (ls-compile string env fenv)
 552           ").charCodeAt("
 553           (ls-compile index env fenv)
 554           ")"))
 555
 556 (define-compilation concat-two (string1 string2)
 557   (concat "("
 558           (ls-compile string1 env fenv)
 559           ").concat("
 560           (ls-compile string2 env fenv)
 561           ")"))
 562
 563 (define-compilation funcall (func &rest args)
 564   (concat "("
 565           (ls-compile func env fenv)
 566           ")("
 567           (join (mapcar (lambda (x)
 568                           (ls-compile x env fenv))
 569                         args)
 570                 ", ")
 571           ")"))
 572
 573 (define-compilation apply (func &rest args)
 574   (if (null args)
 575       (concat "(" (ls-compile func env fenv) ")()")
 576       (let ((args (butlast args))
 577             (last (car (last args))))
 578         (concat "(function(){" *newline*
 579                 "var f = " (ls-compile func env fenv) ";" *newline*
 580                 "var args = [" (join (mapcar (lambda (x)
 581                                                (ls-compile x env fenv))
 582                                              args)
 583                                      ", ")
 584                 "];" *newline*
 585                 "var tail = (" (ls-compile last env fenv) ");" *newline*
 586                 "while (tail != false){" *newline*
 587                 "    args.push(tail.car);" *newline*
 588                 "    tail = tail.cdr;" *newline*
 589                 "}" *newline*
 590                 "return f.apply(this, args);" *newline*
 591                 "})()" *newline*))))
 592
 593 (define-compilation js-eval (string)
 594   (concat "eval(" (ls-compile string env fenv)  ")"))
 595
 596
 597 (define-compilation error (string)
 598   (concat "(function (){ throw " (ls-compile string env fenv) ";" "return 0;})()"))
 599
 600 (define-compilation new ()
 601   "{}")
 602
 603 (define-compilation get (object key)
 604   (concat "(" (ls-compile object env fenv) ")[" (ls-compile key env fenv) "]"))
 605
 606 (define-compilation set (object key value)
 607   (concat "(("
 608           (ls-compile object env fenv)
 609           ")["
 610           (ls-compile key env fenv) "]"
 611           " = " (ls-compile value env fenv) ")"))
 612
 613 (defun macrop (x)
 614   (and (symbolp x) (eq (binding-type (lookup-function x *fenv*)) 'macro)))
 615
 616 (defun ls-macroexpand-1 (form env fenv)
 617   (when (macrop (car form))
 618     (let ((binding (lookup-function (car form) *env*)))
 619       (if (eq (binding-type binding) 'macro)
 620           (apply (eval (binding-translation binding)) (cdr form))
 621           form))))
 622
 623 (defun compile-funcall (function args env fenv)
 624   (cond
 625     ((symbolp function)
 626      (concat (lookup-function-translation function fenv)
 627              "("
 628              (join (mapcar (lambda (x) (ls-compile x env fenv)) args)
 629                    ", ")
 630              ")"))
 631     ((and (listp function) (eq (car function) 'lambda))
 632      (concat "(" (ls-compile function env fenv) ")("
 633              (join (mapcar (lambda (x) (ls-compile x env fenv)) args)
 634                    ", ")
 635              ")"))
 636     (t
 637      (error (concat "Invalid function designator " (symbol-name function))))))
 638
 639 (defun ls-compile (sexp env fenv)
 640   (cond
 641     ((symbolp sexp) (lookup-variable-translation sexp env))
 642     ((integerp sexp) (integer-to-string sexp))
 643     ((stringp sexp) (concat "\"" (escape-string sexp) "\""))
 644     ((listp sexp)
 645      (if (assoc (car sexp) *compilations*)
 646          (let ((comp (second (assoc (car sexp) *compilations*))))
 647            (apply comp env fenv (cdr sexp)))
 648          (if (macrop (car sexp))
 649              (ls-compile (ls-macroexpand-1 sexp env fenv) env fenv)
 650              (compile-funcall (car sexp) (cdr sexp) env fenv))))))
 651
 652 (defun ls-compile-toplevel (sexp)
 653   (setq *toplevel-compilations* nil)
 654   (let ((code (ls-compile sexp nil nil)))
 655     (prog1
 656         (concat "/* " (princ-to-string sexp) " */"
 657                 (join (mapcar (lambda (x) (concat x ";" *newline*))
 658                               *toplevel-compilations*)
 659                "")
 660                 code)
 661       (setq *toplevel-compilations* nil))))
 662
 663 #+common-lisp
 664 (progn
 665   (defun read-whole-file (filename)
 666     (with-open-file (in filename)
 667       (let ((seq (make-array (file-length in) :element-type 'character)))
 668         (read-sequence seq in)
 669         seq)))
 670
 671   (defun ls-compile-file (filename output)
 672     (setq *env* nil *fenv* nil)
 673     (setq *compilation-unit-checks* nil)
 674     (with-open-file (out output :direction :output :if-exists :supersede)
 675       (let* ((source (read-whole-file filename))
 676              (in (make-string-stream source)))
 677         (loop
 678            for x = (ls-read in)
 679            until (eq x *eof*)
 680            for compilation = (ls-compile-toplevel x)
 681            when (plusp (length compilation))
 682            do (write-line (concat compilation "; ") out))
 683         (dolist (check *compilation-unit-checks*)
 684           (funcall check))
 685         (setq *compilation-unit-checks* nil))))
 686
 687   (defun bootstrap ()
 688     (ls-compile-file "lispstrack.lisp" "lispstrack.js")))