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 "newline") (char-code #\newline))
 182               (t (char-code (char cname 0))))))
 183          (#\+
 184           (let ((feature (read-until stream #'terminalp)))
 185             (cond
 186               ((string= feature "common-lisp")
 187                (ls-read stream)         ;ignore
 188                (ls-read stream))
 189               ((string= feature "lispstrack")
 190                (ls-read stream))
 191               (t
 192                (error "Unknown reader form.")))))))
 193       (t
 194        (let ((string (read-until stream #'terminalp)))
 195          (if (every #'digit-char-p string)
 196              (parse-integer string)
 197              (intern (string-upcase string))))))))
 198
 199 (defun ls-read-from-string (string)
 200   (ls-read (make-string-stream string)))
 201
 202
 203 ;;;; Compiler
 204
 205 (defvar *compilation-unit-checks* '())
 206
 207 (defvar *env* '())
 208 (defvar *fenv* '())
 209
 210 (defun make-binding (name type js declared)
 211   (list name type js declared))
 212
 213 (defun binding-name (b) (first b))
 214 (defun binding-type (b) (second b))
 215 (defun binding-translation (b) (third b))
 216 (defun binding-declared (b)
 217   (and b (fourth b)))
 218 (defun mark-binding-as-declared (b)
 219   (setcar (cdddr b) t))
 220
 221 (let ((counter 0))
 222   (defun gvarname (symbol)
 223     (concat "v" (integer-to-string (incf counter))))
 224
 225   (defun lookup-variable (symbol env)
 226     (or (assoc symbol env)
 227         (assoc symbol *env*)
 228         (let ((name (symbol-name symbol))
 229               (binding (make-binding symbol 'variable (gvarname symbol) nil)))
 230           (push binding *env*)
 231           (push (lambda ()
 232                   (unless (binding-declared (assoc symbol *env*))
 233                     (error (concat "Undefined variable `" name "'"))))
 234                 *compilation-unit-checks*)
 235           binding)))
 236
 237   (defun lookup-variable-translation (symbol env)
 238     (binding-translation (lookup-variable symbol env)))
 239
 240   (defun extend-local-env (args env)
 241     (append (mapcar (lambda (symbol)
 242                       (make-binding symbol 'variable (gvarname symbol) t))
 243                     args)
 244             env)))
 245
 246 (let ((counter 0))
 247   (defun lookup-function (symbol env)
 248     (or (assoc symbol env)
 249         (assoc symbol *fenv*)
 250         (let ((name (symbol-name symbol))
 251               (binding
 252                (make-binding symbol
 253                              'function
 254                              (concat "f" (integer-to-string (incf counter)))
 255                              nil)))
 256           (push binding *fenv*)
 257           (push (lambda ()
 258                   (unless (binding-declared (assoc symbol *fenv*))
 259                     (error (concat "Undefined function `" name "'"))))
 260                 *compilation-unit-checks*)
 261           binding)))
 262
 263   (defun lookup-function-translation (symbol env)
 264     (binding-translation (lookup-function symbol env))))
 265
 266
 267 (defvar *toplevel-compilations* nil)
 268
 269 (defun %compile-defvar (name)
 270   (let ((b (lookup-variable name *env*)))
 271     (mark-binding-as-declared b)
 272     (push (concat "var " (binding-translation b)) *toplevel-compilations*)))
 273
 274 (defun %compile-defun (name)
 275   (let ((b (lookup-function name *env*)))
 276     (mark-binding-as-declared b)
 277     (push (concat "var " (binding-translation b)) *toplevel-compilations*)))
 278
 279 (defun %compile-defmacro (name lambda)
 280   (push (make-binding name 'macro lambda t) *fenv*))
 281
 282
 283 (defvar *compilations* nil)
 284
 285 (defun ls-compile-block (sexps env fenv)
 286   (join-trailing
 287    (remove nil (mapcar (lambda (x)
 288                          (ls-compile x env fenv))
 289                        sexps))
 290                  ";
 291 "))
 292 (defmacro define-compilation (name args &rest body)
 293   ;; Creates a new primitive `name' with parameters args and
 294   ;; @body. The body can access to the local environment through the
 295   ;; variable ENV.
 296   `(push (list ',name (lambda (env fenv ,@args) ,@body))
 297          *compilations*))
 298
 299 (define-compilation if (condition true false)
 300   (concat "("
 301           (ls-compile condition env fenv)
 302           " ? "
 303           (ls-compile true env fenv)
 304           " : "
 305           (ls-compile false env fenv)
 306           ")"))
 307
 308 ;;; Return the required args of a lambda list
 309 (defun lambda-list-required-argument (lambda-list)
 310   (if (or (null lambda-list) (eq (car lambda-list) '&rest))
 311       nil
 312       (cons (car lambda-list) (lambda-list-required-argument (cdr lambda-list)))))
 313
 314 (defun lambda-list-rest-argument (lambda-list)
 315   (second (member '&rest lambda-list)))
 316
 317 (define-compilation lambda (lambda-list &rest body)
 318   (let ((required-arguments (lambda-list-required-argument lambda-list))
 319         (rest-argument (lambda-list-rest-argument lambda-list)))
 320     (let ((new-env (extend-local-env
 321                     (append (and rest-argument (list rest-argument))
 322                             required-arguments)
 323                     env)))
 324       (concat "(function ("
 325               (join (mapcar (lambda (x)
 326                               (lookup-variable-translation x new-env))
 327                             required-arguments)
 328                     ",")
 329               "){"
 330               *newline*
 331               (if rest-argument
 332                   (let ((js!rest (lookup-variable-translation rest-argument new-env)))
 333                     (concat "var " js!rest "= false;" *newline*
 334                             "for (var i = arguments.length-1; i>="
 335                             (integer-to-string (length required-arguments))
 336                             "; i--)" *newline*
 337                             js!rest " = "
 338                             "{car: arguments[i], cdr: " js!rest "};"
 339                             *newline*))
 340                   "")
 341               (concat (ls-compile-block (butlast body) new-env fenv)
 342                       "return " (ls-compile (car (last body)) new-env fenv) ";")
 343               *newline*
 344               "})"))))
 345
 346 (define-compilation fsetq (var val)
 347   (concat (lookup-function-translation var fenv)
 348           " = "
 349           (ls-compile val env fenv)))
 350
 351 (define-compilation setq (var val)
 352   (concat (lookup-variable-translation var env)
 353           " = "
 354            (ls-compile val env fenv)))
 355
 356 ;;; Literals
 357
 358 (defun escape-string (string)
 359   (let ((output "")
 360         (index 0)
 361         (size (length string)))
 362     (while (< index size)
 363       (let ((ch (char string index)))
 364         (when (or (char= ch #\") (char= ch #\\))
 365           (setq output (concat output "\\")))
 366         (when (or (char= ch #\newline))
 367           (setq output (concat output "\\"))
 368           (setq ch #\n))
 369         (setq output (concat output (string ch))))
 370       (incf index))
 371     output))
 372
 373 (defun literal->js (sexp)
 374   (cond
 375     ((null sexp) "false")
 376     ((integerp sexp) (integer-to-string sexp))
 377     ((stringp sexp) (concat "\"" (escape-string sexp) "\""))
 378     ((symbolp sexp) (ls-compile `(intern ,(escape-string (symbol-name sexp))) *env* *fenv*))
 379     ((consp sexp) (concat "{car: "
 380                           (literal->js (car sexp))
 381                           ", cdr: "
 382                           (literal->js (cdr sexp)) "}"))))
 383
 384 (let ((counter 0))
 385   (defun literal (form)
 386     (let ((var (concat "l" (integer-to-string (incf counter)))))
 387       (push (concat "var " var " = " (literal->js form)) *toplevel-compilations*)
 388       var)))
 389
 390 (define-compilation quote (sexp)
 391   (literal sexp))
 392
 393 (define-compilation debug (form)
 394   (concat "console.log(" (ls-compile form env fenv) ")"))
 395
 396 (define-compilation while (pred &rest body)
 397   (concat "(function(){ while("
 398           (ls-compile pred env fenv)
 399           "){"
 400           (ls-compile-block body env fenv)
 401           "}})()"))
 402
 403 (define-compilation function (x)
 404   (cond
 405     ((and (listp x) (eq (car x) 'lambda))
 406      (ls-compile x env fenv))
 407     ((symbolp x)
 408      (lookup-function-translation x fenv))))
 409
 410 #+common-lisp
 411 (defmacro eval-when-compile (&body body)
 412   `(eval-when (:compile-toplevel :load-toplevel :execute)
 413      ,@body))
 414
 415 (define-compilation eval-when-compile (&rest body)
 416   (eval (cons 'progn body))
 417   nil)
 418
 419 (defmacro define-transformation (name args form)
 420   `(define-compilation ,name ,args
 421      (ls-compile ,form env fenv)))
 422
 423 (define-transformation progn (&rest body)
 424   `((lambda () ,@body)))
 425
 426 (define-transformation let (bindings &rest body)
 427   (let ((bindings (mapcar #'ensure-list bindings)))
 428     `((lambda ,(mapcar 'car bindings) ,@body)
 429       ,@(mapcar 'cadr bindings))))
 430
 431 ;;; A little backquote implementation without optimizations of any
 432 ;;; kind for lispstrack.
 433 (defun backquote-expand-1 (form)
 434   (cond
 435     ((symbolp form)
 436      (list 'quote form))
 437     ((atom form)
 438      form)
 439     ((eq (car form) 'unquote)
 440      (car form))
 441     ((eq (car form) 'backquote)
 442      (backquote-expand-1 (backquote-expand-1 (cadr form))))
 443     (t
 444      (cons 'append
 445            (mapcar (lambda (s)
 446                      (cond
 447                        ((and (listp s) (eq (car s) 'unquote))
 448                         (list 'list (cadr s)))
 449                        ((and (listp s) (eq (car s) 'unquote-splicing))
 450                         (cadr s))
 451                        (t
 452                         (list 'list (backquote-expand-1 s)))))
 453                    form)))))
 454
 455 (defun backquote-expand (form)
 456   (if (and (listp form) (eq (car form) 'backquote))
 457       (backquote-expand-1 (cadr form))
 458       form))
 459
 460 (defmacro backquote (form)
 461   (backquote-expand-1 form))
 462
 463 (define-transformation backquote (form)
 464   (backquote-expand-1 form))
 465
 466 ;;; Primitives
 467
 468 (define-compilation + (x y)
 469   (concat "((" (ls-compile x env fenv) ") + (" (ls-compile y env fenv) "))"))
 470
 471 (define-compilation - (x y)
 472   (concat "((" (ls-compile x env fenv) ") - (" (ls-compile y env fenv) "))"))
 473
 474 (define-compilation * (x y)
 475   (concat "((" (ls-compile x env fenv) ") * (" (ls-compile y env fenv) "))"))
 476
 477 (define-compilation / (x y)
 478   (concat "((" (ls-compile x env fenv) ") / (" (ls-compile y env fenv) "))"))
 479
 480 (define-compilation < (x y)
 481   (concat "((" (ls-compile x env fenv) ") < (" (ls-compile y env fenv) "))"))
 482
 483 (define-compilation = (x y)
 484   (concat "((" (ls-compile x env fenv) ") == (" (ls-compile y env fenv) "))"))
 485
 486 (define-compilation numberp (x)
 487   (concat "(typeof (" (ls-compile x env fenv) ") == \"number\")"))
 488
 489
 490 (define-compilation mod (x y)
 491   (concat "((" (ls-compile x env fenv) ") % (" (ls-compile y env fenv) "))"))
 492
 493 (define-compilation floor (x)
 494   (concat "(Math.floor(" (ls-compile x env fenv) "))"))
 495
 496 (define-compilation null (x)
 497   (concat "(" (ls-compile x env fenv) "== false)"))
 498
 499 (define-compilation cons (x y)
 500   (concat "{car: " (ls-compile x env fenv) ", cdr: " (ls-compile y env fenv) "}"))
 501
 502 (define-compilation consp (x)
 503   (concat "(function(){ var tmp = "
 504           (ls-compile x env fenv)
 505           "; return (typeof tmp == 'object' && 'car' in tmp);})()"))
 506
 507 (define-compilation car (x)
 508   (concat "(" (ls-compile x env fenv) ").car"))
 509
 510 (define-compilation cdr (x)
 511   (concat "(" (ls-compile x env fenv) ").cdr"))
 512
 513 (define-compilation setcar (x new)
 514   (concat "((" (ls-compile x env fenv) ").car = " (ls-compile new env fenv) ")"))
 515
 516 (define-compilation setcdr (x new)
 517   (concat "((" (ls-compile x env fenv) ").cdr = " (ls-compile new env fenv) ")"))
 518
 519 (define-compilation symbolp (x)
 520   (concat "(function(){ var tmp = "
 521           (ls-compile x env fenv)
 522           "; return (typeof tmp == 'object' && 'name' in tmp); })()"))
 523
 524 (define-compilation make-symbol (name)
 525   (concat "{name: " (ls-compile name env fenv) "}"))
 526
 527 (define-compilation symbol-name (x)
 528   (concat "(" (ls-compile x env fenv) ").name"))
 529
 530 (define-compilation eq (x y)
 531   (concat "(" (ls-compile x env fenv) " === " (ls-compile y env fenv) ")"))
 532
 533 (define-compilation equal (x y)
 534   (concat "(" (ls-compile x env fenv) " == " (ls-compile y env fenv) ")"))
 535
 536 (define-compilation string (x)
 537   (concat "String.fromCharCode(" (ls-compile x env fenv) ")"))
 538
 539 (define-compilation stringp (x)
 540   (concat "(typeof(" (ls-compile x env fenv) ") == \"string\")"))
 541
 542 (define-compilation string-upcase (x)
 543   (concat "(" (ls-compile x env fenv) ").toUpperCase()"))
 544
 545 (define-compilation string-length (x)
 546   (concat "(" (ls-compile x env fenv) ").length"))
 547
 548 (define-compilation char (string index)
 549   (concat "("
 550           (ls-compile string env fenv)
 551           ").charCodeAt("
 552           (ls-compile index env fenv)
 553           ")"))
 554
 555 (define-compilation concat-two (string1 string2)
 556   (concat "("
 557           (ls-compile string1 env fenv)
 558           ").concat("
 559           (ls-compile string2 env fenv)
 560           ")"))
 561
 562 (define-compilation funcall (func &rest args)
 563   (concat "("
 564           (ls-compile func env fenv)
 565           ")("
 566           (join (mapcar (lambda (x)
 567                           (ls-compile x env fenv))
 568                         args)
 569                 ", ")
 570           ")"))
 571
 572 (define-compilation apply (func &rest args)
 573   (if (null args)
 574       (concat "(" (ls-compile func env fenv) ")()")
 575       (let ((args (butlast args))
 576             (last (car (last args))))
 577         (concat "(function(){" *newline*
 578                 "var f = " (ls-compile func env fenv) ";" *newline*
 579                 "var args = [" (join (mapcar (lambda (x)
 580                                                (ls-compile x env fenv))
 581                                              args)
 582                                      ", ")
 583                 "];" *newline*
 584                 "var tail = (" (ls-compile last env fenv) ");" *newline*
 585                 "while (tail != false){" *newline*
 586                 "    args.push(tail.car);" *newline*
 587                 "    tail = tail.cdr;" *newline*
 588                 "}" *newline*
 589                 "return f.apply(this, args);" *newline*
 590                 "})()" *newline*))))
 591
 592 (define-compilation js-eval (string)
 593   (concat "eval(" (ls-compile string env fenv)  ")"))
 594
 595
 596 (define-compilation error (string)
 597   (concat "(function (){ throw " (ls-compile string env fenv) ";" "return 0;})()"))
 598
 599 (define-compilation new ()
 600   "{}")
 601
 602 (define-compilation get (object key)
 603   (concat "(" (ls-compile object env fenv) ")[" (ls-compile key env fenv) "]"))
 604
 605 (define-compilation set (object key value)
 606   (concat "(("
 607           (ls-compile object env fenv)
 608           ")["
 609           (ls-compile key env fenv) "]"
 610           " = " (ls-compile value env fenv) ")"))
 611
 612 (defun macrop (x)
 613   (and (symbolp x) (eq (binding-type (lookup-function x *fenv*)) 'macro)))
 614
 615 (defun ls-macroexpand-1 (form env fenv)
 616   (when (macrop (car form))
 617     (let ((binding (lookup-function (car form) *env*)))
 618       (if (eq (binding-type binding) 'macro)
 619           (apply (eval (binding-translation binding)) (cdr form))
 620           form))))
 621
 622 (defun compile-funcall (function args env fenv)
 623   (cond
 624     ((symbolp function)
 625      (concat (lookup-function-translation function fenv)
 626              "("
 627              (join (mapcar (lambda (x) (ls-compile x env fenv)) args)
 628                    ", ")
 629              ")"))
 630     ((and (listp function) (eq (car function) 'lambda))
 631      (concat "(" (ls-compile function env fenv) ")("
 632              (join (mapcar (lambda (x) (ls-compile x env fenv)) args)
 633                    ", ")
 634              ")"))
 635     (t
 636      (error (concat "Invalid function designator " (symbol-name function))))))
 637
 638 (defun ls-compile (sexp env fenv)
 639   (cond
 640     ((symbolp sexp) (lookup-variable-translation sexp env))
 641     ((integerp sexp) (integer-to-string sexp))
 642     ((stringp sexp) (concat "\"" (escape-string sexp) "\""))
 643     ((listp sexp)
 644      (if (assoc (car sexp) *compilations*)
 645          (let ((comp (second (assoc (car sexp) *compilations*))))
 646            (apply comp env fenv (cdr sexp)))
 647          (if (macrop (car sexp))
 648              (ls-compile (ls-macroexpand-1 sexp env fenv) env fenv)
 649              (compile-funcall (car sexp) (cdr sexp) env fenv))))))
 650
 651 (defun ls-compile-toplevel (sexp)
 652   (setq *toplevel-compilations* nil)
 653   (let ((code (ls-compile sexp nil nil)))
 654     (prog1
 655         (concat "/* " (princ-to-string sexp) " */"
 656                 (join (mapcar (lambda (x) (concat x ";" *newline*))
 657                               *toplevel-compilations*)
 658                "")
 659                 code)
 660       (setq *toplevel-compilations* nil))))
 661
 662 #+common-lisp
 663 (progn
 664   (defun read-whole-file (filename)
 665     (with-open-file (in filename)
 666       (let ((seq (make-array (file-length in) :element-type 'character)))
 667         (read-sequence seq in)
 668         seq)))
 669
 670   (defun ls-compile-file (filename output)
 671     (setq *env* nil *fenv* nil)
 672     (setq *compilation-unit-checks* nil)
 673     (with-open-file (out output :direction :output :if-exists :supersede)
 674       (let* ((source (read-whole-file filename))
 675              (in (make-string-stream source)))
 676         (loop
 677            for x = (ls-read in)
 678            until (eq x *eof*)
 679            for compilation = (ls-compile-toplevel x)
 680            when (plusp (length compilation))
 681            do (write-line (concat compilation "; ") out))
 682         (dolist (check *compilation-unit-checks*)
 683           (funcall check))
 684         (setq *compilation-unit-checks* nil))))
 685
 686   (defun bootstrap ()
 687     (ls-compile-file "lispstrack.lisp" "lispstrack.js")))