Reloadable code.

Makefile

@@ -13,7 +13,7 @@ stop-service:
 	sudo svc -d /etc/service/$$(basename $$(pwd))
 
 compile:
-	raco make src/main.rkt
+	raco make src/main.rkt src/site.rkt
 
 clean:
 	find . -depth -type d -iname compiled -exec rm -rf {} \;

src/entrypoint.rkt

@@ -1,14 +1,19 @@
 #lang racket/base
 
-(provide start-service)
+(provide (struct-out entry-point) ;; from reload.rkt
+         make-entry-point ;; from reload.rkt
+         start-service)
 
 (require web-server/servlet-env)
 (require web-server/managers/lru)
+(require "signals.rkt")
+(require "reload.rkt")
 
-(define (start-service #:port [port 8443]
+(define (start-service* #:port [port 8443]
                         #:ssl? [ssl? #t]
                         request-handler-function
                         on-continuation-expiry)
+  (start-restart-signal-watcher)
   (serve/servlet request-handler-function
 		 #:launch-browser? #f
 		 #:quit? #f
@@ -24,3 +29,16 @@
                  #:ssl-cert (and ssl? (build-path (current-directory) "../server-cert.pem"))
                  #:ssl-key (and ssl? (build-path (current-directory) "../private-key.pem"))
 		 #:servlet-regexp #rx""))
+
+(define (start-service #:port [port 8443]
+                       #:ssl? [ssl? #t]
+                       #:reloadable? [reloadable? #t]
+                       request-handler-entry-point
+                       on-continuation-expiry-entry-point)
+  (when (not reloadable?)
+    (set-reload-poll-interval! #f))
+  (reload!)
+  (start-service* #:port port
+                  #:ssl? ssl?
+                  (lambda (req) ((entry-point-value request-handler-entry-point) req))
+                  (lambda (req) ((entry-point-value on-continuation-expiry-entry-point) req))))

src/jsonp-client.rkt

@@ -41,7 +41,7 @@
     (define request-url
       (string->url
        (format "~a~a?~a"
-               (jsonp-baseurl)
+               (or (jsonp-baseurl) (error 'jsonp-rpc! "jsonp-baseurl is not set"))
                site-relative-url
                (alist->form-urlencoded parameters))))
     (define-values (body-port response-headers) (get-pure-port/headers request-url))

src/main.rkt

@@ -2,11 +2,6 @@
 
 (module+ main
   (require "entrypoint.rkt")
-  (require "signals.rkt")
-  (start-restart-signal-watcher)
-  ;; (start-reloadable-service "site.rkt"
-  ;;                           'request-handler
-  ;;                           'on-continuation-expiry)
-  (require "site.rkt")
-  (start-service request-handler on-continuation-expiry)
-  )
+  (start-service #:reloadable? (getenv "SITE_RELOADABLE")
+                 (make-entry-point 'request-handler "site.rkt")
+                 (make-entry-point 'on-continuation-expiry "site.rkt")))

src/packages.rkt

@@ -21,6 +21,7 @@
 (require web-server/private/gzip)
 (require (only-in web-server/private/util exn->string))
 (require net/url)
+(require "reload.rkt")
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
@@ -38,6 +39,11 @@
 (define package-fetch-interval (* 300 1000)) ;; 300 seconds = 300,000 milliseconds = 5 minutes
 (define base-bogus-timeout (* 5 1000)) ;; 5 seconds
 
+(struct package-manager-state (local-packages
+                               all-tags
+                               next-fetch-deadline
+                               next-bogus-timeout) #:prefab)
+
 (define (fetch-remote-packages)
   (log-info "Fetching package list from ~a" package-index-url)
   (define result
@@ -54,35 +60,33 @@
 (define (tombstone? pkg)
   (eq? pkg 'tombstone))
 
-(define (package-manager)
-  (define remote-packages (hash))
-  (define all-tags* (set))
-  (define local-packages (hash))
-  (define next-fetch-deadline 0)
-  (define next-bogus-timeout base-bogus-timeout)
-
-  (define (asynchronously-fetch-remote-packages!)
+(define (asynchronously-fetch-remote-packages state)
   (thread (lambda ()
             (define raw-remote-packages (fetch-remote-packages))
-              (if (hash? raw-remote-packages)
-                  (begin (set! next-bogus-timeout base-bogus-timeout)
-                         (manager-rpc 'refresh-packages! raw-remote-packages))
-                  (begin (set! next-fetch-deadline (+ (current-inexact-milliseconds)
-                                                      next-bogus-timeout))
-                         (log-info "Will retry in ~a ms" next-bogus-timeout)
-                         (set! next-bogus-timeout (min package-fetch-interval
-                                                       (* next-bogus-timeout 1.618)))
-                         (manager-rpc 'ping)))))
-    (set! next-fetch-deadline (+ (current-inexact-milliseconds) package-fetch-interval)))
+            (manager-rpc 'refresh-packages! raw-remote-packages)))
+  (struct-copy package-manager-state state
+               [next-fetch-deadline (+ (current-inexact-milliseconds) package-fetch-interval)]))
 
-  (define (refresh-packages! raw-remote-packages)
-    (set! remote-packages
-          (for/hash (((package-name pkg) (in-hash raw-remote-packages)))
+(define (package-manager)
+  (with-handlers* ((exn:fail? (lambda (e)
+                                (log-error "*** PACKAGE MANAGER CRASHED ***\n~a"
+                                           (exn->string e))
+                                (sleep 5)
+                                (package-manager))))
+    (package-manager-main (package-manager-state (hash)
+                                                 (set)
+                                                 0
+                                                 base-bogus-timeout))))
+
+(define (refresh-packages raw-remote-packages state)
+  (define local-packages (package-manager-state-local-packages state))
+  (define remote-packages (for/hash (((package-name pkg) (in-hash raw-remote-packages)))
                             (values package-name
-                    (hash-set pkg '_SEARCHABLE-TEXT_ (pkg->searchable-text pkg)))))
+                                    (hash-set pkg '_SEARCHABLE-TEXT_
+                                              (pkg->searchable-text pkg)))))
   (define all-package-names (set-union (list->set (hash-keys local-packages))
                                        (list->set (hash-keys remote-packages))))
-    (set! local-packages
+  (define new-local-packages
     (for/fold ((acc (hash))) ((package-name all-package-names))
       (define local-pkg (hash-ref local-packages package-name (lambda () #f)))
       (define remote-pkg (hash-ref remote-packages package-name (lambda () #f)))
@@ -96,68 +100,87 @@
       (if new-local-pkg
           (hash-set acc package-name new-local-pkg)
           acc)))
-    (rebuild-all-tags!))
+  (rebuild-all-tags (struct-copy package-manager-state state
+                                 [local-packages new-local-packages])))
 
-  (define (rebuild-all-tags!)
-    (set! all-tags*
-          (for/fold ((ts (set))) ((pkg (in-hash-values local-packages)))
-            (set-union ts (list->set (or (@ pkg tags) '()))))))
+(define (rebuild-all-tags state)
+  (struct-copy package-manager-state state
+               [all-tags
+                (for/fold ((ts (set)))
+                          ((pkg (in-hash-values (package-manager-state-local-packages state))))
+                  (set-union ts (list->set (or (@ pkg tags) '()))))]))
 
-  (define (replace-package! old-pkg new-pkg)
-    (set! local-packages
+(define (replace-package old-pkg new-pkg state)
+  (define local-packages (package-manager-state-local-packages state))
+  (rebuild-all-tags
+   (struct-copy package-manager-state state
+                [local-packages
                  (hash-set (if old-pkg
                                (hash-remove local-packages (string->symbol (@ old-pkg name)))
                                local-packages)
                            (string->symbol (@ (or new-pkg old-pkg) name))
-                    (or new-pkg 'tombstone)))
-    (rebuild-all-tags!))
+                           (or new-pkg 'tombstone))])))
 
-  (define (delete-package! package-name)
-    (when (hash-has-key? local-packages package-name)
-      (set! local-packages (hash-set local-packages package-name 'tombstone))))
+(define (delete-package package-name state)
+  (define local-packages (package-manager-state-local-packages state))
+  (if (hash-has-key? local-packages package-name)
+      (struct-copy package-manager-state state
+                   [local-packages (hash-set local-packages package-name 'tombstone)])
+      state))
 
-  (with-handlers ((exn:fail? (lambda (e)
-                               (log-error "*** PACKAGE MANAGER CRASHED ***\n~a"
-                                          (exn->string e))
-                               (sleep 5)
-                               (package-manager))))
-    (let loop ()
+(define (package-manager-main state)
+  (match-define (package-manager-state local-packages
+                                       all-tags
+                                       next-fetch-deadline
+                                       next-bogus-timeout) state)
   (match (sync (handle-evt (thread-receive-evt)
                            (lambda (_) (thread-receive)))
                (handle-evt (alarm-evt next-fetch-deadline)
                            (lambda (_) (list #f 'refresh-packages!))))
     [(cons ch request)
-         (define reply (match request
-                         [(list 'ping)
-                          'pong]
+     (define-values (reply new-state)
+       (match request
          [(list 'next-fetch-deadline)
-                          next-fetch-deadline]
+          (values next-fetch-deadline state)]
          [(list 'refresh-packages!)
-                          (asynchronously-fetch-remote-packages!)]
-                         [(list 'refresh-packages! raw)
-                          (refresh-packages! raw)]
+          (values (void) (asynchronously-fetch-remote-packages state))]
+         [(list 'refresh-packages! (? hash? raw))
+          (values (void)
+                  (struct-copy package-manager-state (refresh-packages raw state)
+                               [next-bogus-timeout base-bogus-timeout]))]
+         [(list 'refresh-packages! _)
+          (log-info "Will retry in ~a ms" next-bogus-timeout)
+          (values (void)
+                  (struct-copy package-manager-state state
+                               [next-fetch-deadline
+                                (+ (current-inexact-milliseconds)
+                                   next-bogus-timeout)]
+                               [next-bogus-timeout
+                                (min package-fetch-interval
+                                     (* next-bogus-timeout 1.618))]))]
          [(list 'packages)
-                          local-packages]
+          (values local-packages state)]
          [(list 'all-package-names)
-                          (hash-keys local-packages)]
+          (values (hash-keys local-packages) state)]
          [(list 'all-tags)
-                          all-tags*]
+          (values all-tags state)]
          [(list 'package-detail name)
           (define pkg (hash-ref local-packages name (lambda () #f)))
-                          (if (tombstone? pkg)
-                              #f
-                              pkg)]
+          (values (if (tombstone? pkg) #f pkg) state)]
          [(list 'replace-package! old-pkg new-pkg)
-                          (replace-package! old-pkg new-pkg)]
-                         [(list 'delete-package! package-name) (delete-package! package-name)]))
+          (values (void) (replace-package old-pkg new-pkg state))]
+         [(list 'delete-package! package-name)
+          (values (void) (delete-package package-name state))]))
      (when ch (channel-put ch reply))
-         (loop)]))))
+     (package-manager-main new-state)]))
 
-(define package-manager-thread (thread package-manager))
+(define package-manager-thread
+  (make-persistent-state 'package-manager-thread
+                         (lambda () (thread package-manager))))
 
 (define (manager-rpc . request)
   (define ch (make-channel))
-  (thread-send package-manager-thread (cons ch request))
+  (thread-send (package-manager-thread) (cons ch request))
   (channel-get ch))
 
 (define (all-package-names) (manager-rpc 'all-package-names))

src/reload.rkt

@@ -0,0 +1,85 @@
+#lang racket/base
+
+(provide (struct-out entry-point)
+         reload-poll-interval
+         set-reload-poll-interval!
+         reload-failure-retry-delay
+         reload!
+         make-entry-point
+         lookup-entry-point
+         make-persistent-state)
+
+(require racket/match)
+(require racket/rerequire)
+(require (only-in web-server/private/util exn->string))
+
+(define reload-poll-interval 0.5) ;; seconds
+(define reload-failure-retry-delay (make-parameter 10)) ;; seconds
+
+(struct entry-point (name module-path identifier-symbol [value #:mutable]) #:prefab)
+
+(define entry-points (make-hash))
+(define persistent-state (make-hash))
+
+(define (set-reload-poll-interval! v)
+  (set! reload-poll-interval v))
+
+(define (reloader-main)
+  (let loop ()
+    (match (sync (handle-evt (thread-receive-evt)
+                             (lambda (_) (thread-receive)))
+                 (if reload-poll-interval
+                     (handle-evt (alarm-evt (+ (current-inexact-milliseconds)
+                                               (* reload-poll-interval 1000)))
+                                 (lambda (_) (list #f 'reload)))
+                     never-evt))
+      [(list ch 'reload)
+       (define result (do-reload!))
+       (when (not result) (sleep (reload-failure-retry-delay)))
+       (when ch (channel-put ch result))])
+    (loop)))
+
+(define reloader-thread (thread reloader-main))
+
+(define (reloader-rpc . request)
+  (define ch (make-channel))
+  (thread-send reloader-thread (cons ch request))
+  (channel-get ch))
+
+(define (reload!) (reloader-rpc 'reload))
+
+;; Only to be called from reloader-main
+(define (do-reload!)
+  (with-handlers ((exn:fail?
+                   (lambda (e)
+                     (log-error "*** WHILE RELOADING CODE***\n~a" (exn->string e))
+                     #f)))
+    (for ((e (in-hash-values entry-points)))
+      (match-define (entry-point _ module-path identifier-symbol _) e)
+      (dynamic-rerequire module-path #:verbosity 'all)
+      (set-entry-point-value! e (dynamic-require module-path identifier-symbol)))
+    #t))
+
+(define (make-entry-point name module-path [identifier-symbol name])
+  (when (hash-has-key? entry-points name)
+    (error 'make-entry-point "Duplicate entry-point name ~a" name))
+  (define e (entry-point name module-path identifier-symbol #f))
+  (hash-set! entry-points name e)
+  e)
+
+(define (lookup-entry-point name)
+  (hash-ref entry-points name))
+
+(define (make-persistent-state name initial-value-thunk)
+  (hash-ref persistent-state
+            name
+            (lambda ()
+              (define value (initial-value-thunk))
+              (define handler
+                (case-lambda
+                  [() value]
+                  [(new-value)
+                   (set! value new-value)
+                   value]))
+              (hash-set! persistent-state name handler)
+              handler)))

src/sessions.rkt

@@ -10,13 +10,14 @@
          lookup-session)
 
 (require "randomness.rkt")
+(require "reload.rkt")
 
 (define current-session (make-parameter #f))
 (define session-lifetime (make-parameter (* 7 24 60 60 1000))) ;; one week in milliseconds
 
-(struct session (key expiry email password) #:transparent)
+(struct session (key expiry email password) #:prefab)
 
-(define sessions (make-hash))
+(define sessions (make-persistent-state 'session-store (lambda () (make-hash))))
 
 (define (current-email)
   (define s (current-session))
@@ -24,15 +25,16 @@
 
 (define (expire-sessions!)
   (define now (current-inexact-milliseconds))
-  (for ((session-key (hash-keys sessions)))
-    (define s (hash-ref sessions session-key (lambda () #f)))
+  (define ss (sessions))
+  (for ((session-key (hash-keys ss)))
+    (define s (hash-ref ss session-key (lambda () #f)))
     (when (and s (<= (session-expiry s) now))
-      (hash-remove! sessions session-key))))
+      (hash-remove! ss session-key))))
 
 (define (create-session! email password)
   (expire-sessions!)
   (define session-key (bytes->string/utf-8 (random-bytes/base64 32)))
-  (hash-set! sessions
+  (hash-set! (sessions)
              session-key
              (session session-key
                       (+ (current-inexact-milliseconds) (session-lifetime))
@@ -41,15 +43,16 @@
   session-key)
 
 (define (destroy-session! session-key)
-  (hash-remove! sessions session-key))
+  (hash-remove! (sessions) session-key))
 
 (define (lookup-session/touch! session-key)
-  (define s (hash-ref sessions session-key (lambda () #f)))
+  (log-info "Looking up session ~a" session-key)
+  (define s (hash-ref (sessions) session-key (lambda () #f)))
   (and s
        (let ((s1 (struct-copy session s [expiry (+ (current-inexact-milliseconds)
                                                    (session-lifetime))])))
-         (hash-set! sessions session-key s1)
+         (hash-set! (sessions) session-key s1)
          s1)))
 
 (define (lookup-session session-key)
-  (hash-ref sessions session-key (lambda () #f)))
+  (hash-ref (sessions) session-key (lambda () #f)))

src/signals.rkt

@@ -4,6 +4,8 @@
 (provide poll-signal
 	 start-restart-signal-watcher)
 
+(require "reload.rkt")
+
 (define (poll-signal signal-file-name message handler)
   (when (file-exists? signal-file-name)
     (log-info message)
@@ -24,5 +26,8 @@
        (poll-signal "../signals/.restart-required"
 		    "Restart signal received - attempting to restart"
 		    (lambda () (exit 0)))
+       (poll-signal "../signals/.reload"
+                    "Reload signal received - attempting to reload code"
+                    (lambda () (reload!)))
        (sleep 0.5)
        (loop)))))

src/site.rkt

@@ -19,20 +19,26 @@
 (define nav-index "Package Index")
 (define nav-search "Search")
 
-(bootstrap-navbar-header
+(define navbar-header
   `(a ((href "http://www.racket-lang.org/"))
     (img ((src "/logo-and-text.png")
           (height "60")
           (alt "Racket Package Index")))))
 
-(bootstrap-navigation `((,nav-index "/")
+(define navigation `((,nav-index "/")
                      (,nav-search "/search")
                      ;; ((div ,(glyphicon 'download-alt)
                      ;;       " Download")
                      ;;  "http://download.racket-lang.org/")
                      ))
 
-(jsonp-baseurl "https://pkgd.racket-lang.org")
+(define backend-baseurl "https://pkgd.racket-lang.org")
+
+(define default-empty-source-url "git://github.com//")
+(define COOKIE "pltsession")
+(define recent-seconds (* 2 24 60 60)) ;; two days
+
+(struct draft-package (old-name name description authors tags versions) #:prefab)
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
@@ -51,18 +57,18 @@
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(define default-empty-source-url "git://github.com//")
-(define COOKIE "pltsession")
-(define recent-seconds (* 2 24 60 60)) ;; two days
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
 (define-syntax-rule (authentication-wrap #:request request body ...)
   (authentication-wrap* #f request (lambda () body ...)))
 
 (define-syntax-rule (authentication-wrap/require-login #:request request body ...)
   (authentication-wrap* #t request (lambda () body ...)))
 
+(define-syntax-rule (with-site-config body ...)
+  (parameterize ((bootstrap-navbar-header navbar-header)
+                 (bootstrap-navigation navigation)
+                 (jsonp-baseurl backend-baseurl))
+    body ...))
+
 (define clear-session-cookie (make-cookie COOKIE
                                           ""
                                           #:path "/"
@@ -90,7 +96,8 @@
                       (if new-session-key
                           (list (make-cookie COOKIE new-session-key #:path "/" #:secure? #t))
                           (list clear-session-cookie))))
-        (bootstrap-redirect (url->string (request-uri request)))))
+        (with-site-config
+         (bootstrap-redirect (url->string (request-uri request))))))
 
     (send/suspend/dispatch
      (lambda (embed-url)
@@ -137,7 +144,7 @@
                                                   #:path "/"
                                                   #:secure? #t))
                                (list))))
-             (body)))))))
+             (with-site-config (body))))))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
@@ -191,6 +198,7 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (define (login-page [error-message #f])
+  (with-site-config
    (send/suspend/dispatch
     (lambda (embed-url)
       (bootstrap-response "Login"
@@ -210,7 +218,7 @@
                                (form-group 4 5
                                            `(div ((class "alert alert-danger"))
                                              (p ,error-message))))
-                           ,(form-group 4 5 (primary-button "Log in")))))))
+                            ,(form-group 4 5 (primary-button "Log in"))))))))
 
 (define (authenticate-with-server! email password code)
   (jsonp-rpc! #:sensitive? #t
@@ -236,6 +244,7 @@
 (define (register-page #:email [email ""]
                        #:code [code ""]
                        #:error-message [error-message #f])
+  (with-site-config
    (send/suspend/dispatch
     (lambda (embed-url)
       (bootstrap-response "Register/Reset Account"
@@ -270,7 +279,7 @@
                                    (role "form"))
                                   ,(form-group 2 2 (label "email" "Email address")
                                                0 5 (email-input "email_for_code"))
-                                 ,(form-group 4 5 (primary-button "Email me a code"))))))))
+                                  ,(form-group 4 5 (primary-button "Email me a code")))))))))
 
 (define (apply-account-code request)
   (define-form-bindings request (email code password confirm_password))
@@ -304,6 +313,7 @@
   (summarise-code-emailing "Account registration/reset code emailed" email_for_code))
 
 (define (summarise-code-emailing reason email)
+  (with-site-config
    (send/suspend/dispatch
     (lambda (embed-url)
       (bootstrap-response reason
@@ -313,7 +323,7 @@
                             "the button to continue:")
                           `(a ((class "btn btn-primary")
                                (href ,(embed-url (lambda (req) (register-page)))))
-                           "Enter your code")))))
+                            "Enter your code"))))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
@@ -445,9 +455,10 @@
                          (package-summary-table package-name-list)))))
 
 (define (logout-page request)
+  (with-site-config
    (parameterize ((bootstrap-cookies (list clear-session-cookie)))
      (when (current-session) (destroy-session! (session-key (current-session))))
-    (bootstrap-redirect (named-url main-page))))
+     (bootstrap-redirect (named-url main-page)))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
@@ -616,8 +627,6 @@
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(struct draft-package (old-name name description authors tags versions) #:transparent)
-
 (define (edit-package-page request [package-name-str ""])
   (authentication-wrap/require-login
    #:request request
@@ -655,6 +664,7 @@
   (cons default (remove default alist)))
 
 (define (package-form error-message draft)
+  (with-site-config
    (send/suspend/dispatch
     (lambda (embed-url)
 
@@ -795,9 +805,10 @@
                                                 `(a ((class "btn btn-default")
                                                      (href ,(named-url package-page old-name)))
                                                   "Cancel changes and return to package page"))))))
-                           )))))
+                            ))))))
 
 (define ((confirm-package-deletion package-name-str) request)
+  (with-site-config
    (send/suspend
     (lambda (k-url)
       (bootstrap-response "Confirm Package Deletion"
@@ -809,7 +820,7 @@
                                "Confirm deletion")))))
    (jsonp-rpc! "/jsonp/package/del" `((pkg . ,package-name-str)))
    (delete-package! (string->symbol package-name-str))
-  (bootstrap-redirect (named-url main-page)))
+   (bootstrap-redirect (named-url main-page))))
 
 (define ((update-draft draft0) request)
   (define draft (read-draft-form draft0 (request-bindings request)))
@@ -817,7 +828,8 @@
   (match action
     ["save_changes"
      (if (save-draft! draft)
-         (bootstrap-redirect (named-url package-page (~a (draft-package-name draft))))
+         (with-site-config
+          (bootstrap-redirect (named-url package-page (~a (draft-package-name draft)))))
          (package-form "Save failed."
                        ;; ^ TODO: This is the worst error message.
                        ;;         Right up there with "parse error".