diff --git a/module/language/elisp/README b/module/language/elisp/README index 8068351e7..340e52dd9 100644 --- a/module/language/elisp/README +++ b/module/language/elisp/README @@ -5,11 +5,11 @@ This is more or less a lot of work in progress. Here are some notes as well as status information. Already implemented: - * progn + * progn, prog1, prog2 * if, cond, when, unless * not, and, or * referencing and setting (setq) variables - * while, dotimes + * while, dotimes, dolist * let, let* * lambda expressions, function calls using list notation * some built-ins (mainly numbers/arithmetic) @@ -18,8 +18,6 @@ Already implemented: * quotation and backquotation with unquote/unquote-splicing Especially still missing: - * other progX forms, will be done in macros - * dolist using macros * catch/throw, unwind-protect * real elisp reader instead of Scheme's * set, makunbound, boundp functions @@ -31,3 +29,10 @@ Especially still missing: * need fluids for function bindings? * recursive macros * anonymous macros + +Other ideas and things to think about: + * %nil vs. #f/'() handling in Guile, possibly get rid of setting empty rest + arguments to %nil + * don't ensure-fluids for variables known to be let- or argument-bound + * or, perhaps, get rid of ensure-fluids over all but rather scan all code for + variables and create all needed fluids beforehand diff --git a/module/language/elisp/compile-tree-il.scm b/module/language/elisp/compile-tree-il.scm index 815f5f65e..79e0bc59a 100644 --- a/module/language/elisp/compile-tree-il.scm +++ b/module/language/elisp/compile-tree-il.scm @@ -365,6 +365,47 @@ (error "non-pair expression contains unquotes" expr)) (make-const loc expr))) +; Compile a dolist construct. +; This is compiled to something along: +; (with-fluid* iter-var %nil +; (lambda () +; (let iterate ((tail list)) +; (if (null? tail) +; result +; (begin +; (fluid-set! iter-var (car tail)) +; body +; (iterate (cdr tail))))))) + +(define (compile-dolist loc var iter-list result body) + (let* ((tailvar (gensym)) + (iterate (gensym)) + (tailref (make-lexical-ref loc tailvar tailvar)) + (iterate-func (make-lambda loc `(,tailvar) `(,tailvar) '() + (make-conditional loc + (call-primitive loc 'null? tailref) + (compile-expr result) + (make-sequence loc + `(,(set-variable! loc var value-slot + (call-primitive loc 'car tailref)) + ,@(map compile-expr body) + ,(make-application loc + (make-lexical-ref loc iterate iterate) + (list (call-primitive loc 'cdr + tailref))))))))) + + (make-sequence loc + (list (ensure-fluid! loc var value-slot) + (call-primitive loc 'with-fluid* + (make-module-ref loc value-slot var #t) + (nil-value loc) + (make-lambda loc '() '() '() + (make-letrec loc `(,iterate) `(,iterate) `(,iterate-func) + (make-application loc + (make-lexical-ref loc iterate iterate) + (list (compile-expr iter-list)))))))))) + + ; Compile a symbol expression. This is a variable reference or maybe some ; special value like nil. @@ -384,6 +425,16 @@ ((progn . ,forms) (make-sequence loc (map compile-expr forms))) + ; I chose to implement prog1 directly (not with macros) so that the + ; temporary variable used can be a lexical one that is not backed by a fluid + ; for better performance. + ((prog1 ,form1 . ,forms) + (let ((temp (gensym))) + (make-let loc `(,temp) `(,temp) `(,(compile-expr form1)) + (make-sequence loc + (append (map compile-expr forms) + (list (make-lexical-ref loc temp temp))))))) + ((if ,condition ,ifclause) (make-conditional loc (compile-expr condition) (compile-expr ifclause) @@ -544,6 +595,13 @@ (make-letrec loc '(iterate) (list itersym) (list iter-thunk) iter-call))) + ; dolist is treated here rather than as macro because it can take advantage + ; of a non-fluid-based variable. + ((dolist (,var ,iter-list) . ,body) (guard (symbol? var)) + (compile-dolist loc var iter-list 'nil body)) + ((dolist (,var ,iter-list ,result) . ,body) (guard (symbol? var)) + (compile-dolist loc var iter-list result body)) + ; Either (lambda ...) or (function (lambda ...)) denotes a lambda-expression ; that should be compiled. ((lambda ,args . ,body) diff --git a/module/language/elisp/runtime/macro-slot.scm b/module/language/elisp/runtime/macro-slot.scm index 9a4c52ca5..a9381ebb1 100644 --- a/module/language/elisp/runtime/macro-slot.scm +++ b/module/language/elisp/runtime/macro-slot.scm @@ -28,6 +28,14 @@ ; here. +; The prog2 construct can be directly defined in terms of prog1 and progn, +; so this is done using a macro. + +(built-in-macro prog2 + (lambda (form1 form2 . rest) + `(progn ,form1 (prog1 ,form2 ,@rest)))) + + ; Define the conditionals when and unless as macros. (built-in-macro when @@ -39,11 +47,15 @@ `(if ,condition nil (progn ,@elses)))) -; Define the dotimes and dolist iteration macros. +; Define the dotimes iteration macro. ; As the variable has to be bound locally for elisp, this needs to go through ; the dynamic scoping fluid system. So we can't speed these forms up by ; implementing them directly in the compiler with just a lexical variable ; anyways. +; For dolist, on the other hand, we have to bind the elisp variable to the +; list elements but keep track of the list-tails in another one. Therefore, +; this can take advantage of real compilation because of circumventing the +; fluid-system for this variable. (built-in-macro dotimes (lambda (args . body) diff --git a/test-suite/tests/elisp-compiler.test b/test-suite/tests/elisp-compiler.test index 43a34d7ec..e475045e8 100644 --- a/test-suite/tests/elisp-compiler.test +++ b/test-suite/tests/elisp-compiler.test @@ -50,7 +50,19 @@ (pass-if-equal "progn" 1 (progn (setq a 0) (setq a (1+ a)) - a))) + a)) + + (pass-if "prog1" + (progn (setq a 0) + (setq b (prog1 a (setq a (1+ a)))) + (and (= a 1) (= b 0)))) + + (pass-if "prog2" + (progn (setq a 0) + (setq b (prog2 (setq a (1+ a)) + (setq a (1+ a)) + (setq a (1+ a)))) + (and (= a 3) (= b 2))))) (with-test-prefix/compile "Conditionals" @@ -122,7 +134,18 @@ (setq j (1+ i)) (setq a (+ a j)))) (setq c (dotimes (i 10 42) nil)) - (and (= a 5050) (equal b nil) (= c 42))))) + (and (= a 5050) (equal b nil) (= c 42)))) + + (pass-if "dolist" + (let ((mylist '(7 2 5))) + (setq sum 0) + (setq a (dolist (i mylist) + (setq sum (+ sum i)))) + (setq b (dolist (i mylist 5) 0)) + (and (= sum (+ 7 2 5)) + (equal a nil) + (equal mylist '(7 2 5)) + (equal b 5))))) ; Test handling of variables.