emacs-compatible lexical binding

* module/language/elisp/bindings.scm (global?): New function.
* module/language/elisp/compile-tree-il.scm (lexical-binding): New
  variable.
  (bind-lexically?): If lexical binding is enabled, bind lexically
  unless a special binding exists.
  (compile-%set-lexical-binding-mode): New function.
* module/language/elisp/lexer.scm (lexical-binding-regexp): New
  variable.
  (lex): Return a `set-lexical-binding-mode!' token if a comment is
  found while reading the first line.
* module/language/elisp/parser.scm (get-expression): Add support for
  `set-lexical-binding-mode!' tokens.
* module/language/elisp/runtime/function-slot.scm: Import and re-export
  the `%set-lexical-binding-mode' special form.
* test-suite/tests/elisp-compiler.test
  ("Let and Let*")["lambda args inside lexical-let"]: Update.

module/language/elisp/bindings.scm

@@ -24,6 +24,7 @@
   #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-26)
   #:export (make-bindings
+            global?
             mark-global!
             map-globals
             with-lexical-bindings
@@ -57,6 +58,9 @@
 (define (make-bindings)
   (%make-bindings '() (make-hash-table)))
 
+(define (global? bindings sym module)
+  (and=> (assoc-ref (globals bindings) module) (cut memq sym <>)))
+
 ;;; Mark that a given symbol is needed as global in the specified
 ;;; slot-module.
 

module/language/elisp/compile-tree-il.scm

@@ -50,7 +50,8 @@
             compile-defmacro
             compile-defun
             #{compile-`}#
-            compile-quote))
+            compile-quote
+            compile-%set-lexical-binding-mode))
 
 ;;; Certain common parameters (like the bindings data structure or
 ;;; compiler options) are not always passed around but accessed using
@@ -66,6 +67,8 @@
 
 (define always-lexical (make-fluid))
 
+(define lexical-binding (make-fluid))
+
 ;;; Find the source properties of some parsed expression if there are
 ;;; any associated with it.
 
@@ -245,7 +248,10 @@
            (let ((always (fluid-ref always-lexical)))
              (or (eq? always 'all)
                  (memq sym always)
-                 (get-lexical-binding (fluid-ref bindings-data) sym))))))
+                 (get-lexical-binding (fluid-ref bindings-data) sym)
+                 (and
+                  (fluid-ref lexical-binding)
+                  (not (global? (fluid-ref bindings-data) sym module))))))))
 
 (define (split-let-bindings bindings module)
   (let iterate ((tail bindings)
@@ -854,6 +860,12 @@
     ((,val)
      (make-const loc val))))
 
+(defspecial %set-lexical-binding-mode (loc args)
+  (pmatch args
+    ((,val)
+     (fluid-set! lexical-binding val)
+     (make-void loc))))
+
 ;;; Compile a compound expression to Tree-IL.
 
 (define (compile-pair loc expr)

module/language/elisp/lexer.scm

@@ -252,7 +252,15 @@
 ;;; Main lexer routine, which is given a port and does look for the next
 ;;; token.
 
+(define lexical-binding-regexp
+  (make-regexp
+   "-\\*-(|.*;)[ \t]*lexical-binding:[ \t]*([^;]*[^ \t;]).*-\\*-"))
+
 (define (lex port)
+  (define (lexical-binding-value string)
+    (and=> (regexp-exec lexical-binding-regexp string)
+           (lambda (match)
+             (not (member (match:substring match 2) '("nil" "()"))))))
   (let ((return (let ((file (if (file-port? port)
                                 (port-filename port)
                                 #f))
@@ -283,11 +291,19 @@
       (case c
         ;; A line comment, skip until end-of-line is found.
         ((#\;)
-         (let iterate ()
+         (if (= (port-line port) 0)
-           (let ((cur (read-char port)))
+             (let iterate ((chars '()))
-             (if (or (eof-object? cur) (char=? cur #\newline))
+               (let ((cur (read-char port)))
-                 (lex port)
+                 (if (or (eof-object? cur) (char=? cur #\newline))
-                 (iterate)))))
+                     (let ((string (list->string (reverse chars))))
+                       (return 'set-lexical-binding-mode!
+                               (lexical-binding-value string)))
+                     (iterate (cons cur chars)))))
+             (let iterate ()
+               (let ((cur (read-char port)))
+                 (if (or (eof-object? cur) (char=? cur #\newline))
+                     (lex port)
+                     (iterate))))))
         ;; A character literal.
         ((#\?)
          (return 'character (get-character port #f)))

module/language/elisp/parser.scm

@@ -201,6 +201,8 @@
          (setter expr)
          (force-promises! expr)
          expr))
+      ((set-lexical-binding-mode!)
+       (return `(%set-lexical-binding-mode ,(cdr token))))
       (else
        (parse-error token "expected expression, got" token)))))
 

module/language/elisp/runtime/function-slot.scm

@@ -41,7 +41,9 @@
                  (compile-defun . defun)
                  (compile-defmacro . defmacro)
                  (#{compile-`}# . #{`}#)
-                 (compile-quote . quote)))
+                 (compile-quote . quote)
+                 (compile-%set-lexical-binding-mode
+                  . %set-lexical-binding-mode)))
   #:duplicates (last)
   ;; special operators
   #:re-export (progn
@@ -64,6 +66,7 @@
                defun
                defmacro
                #{`}#
-               quote)
+               quote
+               %set-lexical-binding-mode)
   ;; functions
   #:re-export (apply))

test-suite/tests/elisp-compiler.test

@@ -295,7 +295,7 @@
          (defun dyna () a)
          (lexical-let ((a 2) (b 42))
            (and (= a 2) (= (dyna) 1)
-                ((lambda (a) (and (= a 3) (= b 42) (= (dyna) 3))) 3)
+                ((lambda (a) (and (= a 3) (= b 42) (= (dyna) 1))) 3)
                 ((lambda () (let ((a 3))
                               (and (= a 3) (= (dyna) 1)))))
                 (= a 2) (= (dyna) 1)))