diff options
author | BT Templeton <bpt@hcoop.net> | 2011-06-20 17:23:13 -0400 |
---|---|---|
committer | BT Templeton <bpt@hcoop.net> | 2012-02-03 18:53:48 -0500 |
commit | b652e2b93fbcbc43ac8b1e7d7587904f0bf2bc62 (patch) | |
tree | 1c91d1dac90a753f00df22d12dc4cd3ca5c89577 | |
parent | 80687f2e4b50a41cb3b3ebe0cd5a05d7d71d414c (diff) | |
download | guile-b652e2b93fbcbc43ac8b1e7d7587904f0bf2bc62.tar.gz |
rewrite elisp macros in elisp
* module/language/elisp/runtime/macros.scm: Remove.
(macro-lambda, macro-prog1, macro-prog2, macro-cond, macro-and,
macro-or, macro-catch, macro-unwind-protect): Rewrite in Elisp and
move to...
* module/language/elisp/boot.el (lambda, prog1, prog2, cond, and, or,
catch, unwind-protect): ...here.
(eval-and-compile): New macro.
(funcall, fset, null, consp, listp, car, cdr, make-symbol-signal):
Wrap definitions in an `eval-and-compile' form so that they can be
used by the rewritten macros.
* module/language/elisp/runtime.scm: Remove `built-in-macro'.
* module/language/elisp/Makefile.am: Remove
module/language/elisp/runtime/macros.scm from `ELISP_LANG_SOURCES'.
-rw-r--r-- | module/Makefile.am | 1 | ||||
-rw-r--r-- | module/language/elisp/boot.el | 115 | ||||
-rw-r--r-- | module/language/elisp/runtime.scm | 11 | ||||
-rw-r--r-- | module/language/elisp/runtime/function-slot.scm | 19 | ||||
-rw-r--r-- | module/language/elisp/runtime/macros.scm | 144 |
5 files changed, 93 insertions, 197 deletions
diff --git a/module/Makefile.am b/module/Makefile.am index fa13c6ec4..94e109911 100644 --- a/module/Makefile.am +++ b/module/Makefile.am @@ -139,7 +139,6 @@ ELISP_LANG_SOURCES = \ language/elisp/runtime.scm \ language/elisp/runtime/function-slot.scm \ language/elisp/runtime/value-slot.scm \ - language/elisp/runtime/macros.scm \ language/elisp/runtime/subrs.scm \ language/elisp/spec.scm diff --git a/module/language/elisp/boot.el b/module/language/elisp/boot.el index 1862916c6..778cfcd04 100644 --- a/module/language/elisp/boot.el +++ b/module/language/elisp/boot.el @@ -22,11 +22,98 @@ (defmacro @ (module symbol) `(guile-ref ,module ,symbol)) -(defun funcall (function &rest arguments) - (apply function arguments)) - -(defun fset (symbol definition) - (funcall (@ (language elisp runtime subrs) fset) symbol definition)) +(defmacro eval-and-compile (&rest body) + `(progn + (eval-when-compile ,@body) + (progn ,@body))) + +(eval-and-compile + (defun funcall (function &rest arguments) + (apply function arguments)) + (defun fset (symbol definition) + (funcall (@ (language elisp runtime subrs) fset) symbol definition)) + (defun null (object) + (if object nil t)) + (fset 'consp (@ (guile) pair?)) + (defun listp (object) + (if object (consp object) t)) + (defun car (list) + (if list (funcall (@ (guile) car) list) nil)) + (defun cdr (list) + (if list (funcall (@ (guile) cdr) list) nil)) + (fset 'make-symbol (@ (guile) make-symbol)) + (defun signal (&rest args) + (funcall (@ (guile) throw) 'elisp-error args))) + +(defmacro lambda (&rest cdr) + `#'(lambda ,@cdr)) + +(defmacro prog1 (first &rest body) + (let ((temp (make-symbol "prog1-temp"))) + `(lexical-let ((,temp ,first)) + ,@body + ,temp))) + +(defmacro prog2 (form1 form2 &rest body) + `(progn ,form1 (prog1 ,form2 ,@body))) + +(defmacro cond (&rest clauses) + (if (null clauses) + nil + (let ((first (car clauses)) + (rest (cdr clauses))) + (if (listp first) + (let ((condition (car first)) + (body (cdr first))) + (if (null body) + (let ((temp (make-symbol "cond-temp"))) + `(lexical-let ((,temp ,condition)) + (if ,temp + ,temp + (cond ,@rest)))) + `(if ,condition + (progn ,@body) + (cond ,@rest)))) + (signal 'wrong-type-argument `(listp ,first)))))) + +(defmacro and (&rest conditions) + (cond ((null conditions) t) + ((null (cdr conditions)) (car conditions)) + (t `(if ,(car conditions) + (and ,@(cdr conditions)) + nil)))) + +(defmacro or (&rest conditions) + (cond ((null conditions) nil) + ((null (cdr conditions)) (car conditions)) + (t (let ((temp (make-symbol "or-temp"))) + `(lexical-let ((,temp ,(car conditions))) + (if ,temp + ,temp + (or ,@(cdr conditions)))))))) + +(defmacro catch (tag &rest body) + (let* ((temp (make-symbol "catch-temp")) + (elisp-key (make-symbol "catch-elisp-key")) + (dummy-key (make-symbol "catch-dummy-key")) + (value (make-symbol "catch-value"))) + `(lexical-let ((,temp ,tag)) + (funcall (@ (guile) catch) + t + #'(lambda () ,@body) + #'(lambda (,dummy-key ,elisp-key ,value) + (if (eq ,elisp-key ,temp) + ,value + (funcall (@ (guile) throw) + ,dummy-key + ,elisp-key + ,value))))))) + +(defmacro unwind-protect (bodyform &rest unwindforms) + `(funcall (@ (guile) dynamic-wind) + #'(lambda () nil) + #'(lambda () ,bodyform) + #'(lambda () ,@unwindforms))) (fset 'symbol-value (@ (language elisp runtime subrs) symbol-value)) (fset 'symbol-function (@ (language elisp runtime subrs) symbol-function)) @@ -110,19 +197,11 @@ ;;; List predicates -(fset 'consp (@ (guile) pair?)) - -(defun null (object) - (if object nil t)) - (fset 'not #'null) (defun atom (object) (null (consp object))) -(defun listp (object) - (or (consp object) (null object))) - (defun nlistp (object) (null (listp object))) @@ -134,16 +213,6 @@ (fset 'append (@ (guile) append)) (fset 'reverse (@ (guile) reverse)) -(defun car (list) - (if (null list) - nil - (funcall (@ (guile) car) list))) - -(defun cdr (list) - (if (null list) - nil - (funcall (@ (guile) cdr) list))) - (defun car-safe (object) (if (consp object) (car object) diff --git a/module/language/elisp/runtime.scm b/module/language/elisp/runtime.scm index 524b82987..8ffc94656 100644 --- a/module/language/elisp/runtime.scm +++ b/module/language/elisp/runtime.scm @@ -29,7 +29,7 @@ set-variable! runtime-error macro-error) - #:export-syntax (built-in-macro defspecial prim)) + #:export-syntax (defspecial prim)) ;;; This module provides runtime support for the Elisp front-end. @@ -118,15 +118,6 @@ datum)) data))))) -(define-syntax built-in-macro - (lambda (x) - (syntax-case x () - ((_ name value) - (with-syntax ((scheme-name (make-id #'name 'macro- #'name))) - #'(begin - (define-public scheme-name (make-fluid)) - (fluid-set! scheme-name (cons 'macro value)))))))) - (define-syntax defspecial (lambda (x) (syntax-case x () diff --git a/module/language/elisp/runtime/function-slot.scm b/module/language/elisp/runtime/function-slot.scm index 641173d86..3fe47fb6e 100644 --- a/module/language/elisp/runtime/function-slot.scm +++ b/module/language/elisp/runtime/function-slot.scm @@ -19,16 +19,6 @@ (define-module (language elisp runtime function-slot) #:use-module ((language elisp runtime subrs) #:select (apply)) - #:use-module ((language elisp runtime macros) - #:select - ((macro-lambda . lambda) - (macro-prog1 . prog1) - (macro-prog2 . prog2) - (macro-cond . cond) - (macro-and . and) - (macro-or . or) - (macro-catch . catch) - (macro-unwind-protect . unwind-protect))) #:use-module ((language elisp compile-tree-il) #:select ((compile-progn . progn) @@ -75,14 +65,5 @@ defmacro #{`}# quote) - ;; macros - #:re-export (lambda - prog1 - prog2 - cond - and - or - catch - unwind-protect) ;; functions #:re-export (apply)) diff --git a/module/language/elisp/runtime/macros.scm b/module/language/elisp/runtime/macros.scm deleted file mode 100644 index 5a8d186e6..000000000 --- a/module/language/elisp/runtime/macros.scm +++ /dev/null @@ -1,144 +0,0 @@ -;;; Guile Emacs Lisp - -;;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. -;;; -;;; This library is free software; you can redistribute it and/or -;;; modify it under the terms of the GNU Lesser General Public -;;; License as published by the Free Software Foundation; either -;;; version 3 of the License, or (at your option) any later version. -;;; -;;; This library is distributed in the hope that it will be useful, -;;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;;; Lesser General Public License for more details. -;;; -;;; You should have received a copy of the GNU Lesser General Public -;;; License along with this library; if not, write to the Free Software -;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA - -;;; Code: - -(define-module (language elisp runtime macros) - #:use-module (language elisp runtime)) - -;;; This module contains the macro definitions of elisp symbols. In -;;; contrast to the other runtime modules, those are used directly -;;; during compilation, of course, so not really in runtime. But I -;;; think it fits well to the others here. - -(built-in-macro lambda - (lambda cdr - `(function (lambda ,@cdr)))) - -;;; The prog1 and prog2 constructs can easily be defined as macros using -;;; progn and some lexical-let's to save the intermediate value to -;;; return at the end. - -(built-in-macro prog1 - (lambda (form1 . rest) - (let ((temp (gensym))) - `(lexical-let ((,temp ,form1)) - ,@rest - ,temp)))) - -(built-in-macro prog2 - (lambda (form1 form2 . rest) - `(progn ,form1 (prog1 ,form2 ,@rest)))) - -;;; Impement the cond form as nested if's. A special case is a -;;; (condition) subform, in which case we need to return the condition -;;; itself if it is true and thus save it in a local variable before -;;; testing it. - -(built-in-macro cond - (lambda (. clauses) - (let iterate ((tail clauses)) - (if (null? tail) - 'nil - (let ((cur (car tail)) - (rest (iterate (cdr tail)))) - (prim cond - ((prim or (not (list? cur)) (null? cur)) - (macro-error "invalid clause in cond" cur)) - ((null? (cdr cur)) - (let ((var (gensym))) - `(lexical-let ((,var ,(car cur))) - (if ,var - ,var - ,rest)))) - (else - `(if ,(car cur) - (progn ,@(cdr cur)) - ,rest)))))))) - -;;; The and and or forms can also be easily defined with macros. - -(built-in-macro and - (case-lambda - (() 't) - ((x) x) - ((x . args) - (let iterate ((x x) (tail args)) - (if (null? tail) - x - `(if ,x - ,(iterate (car tail) (cdr tail)) - nil)))))) - -(built-in-macro or - (case-lambda - (() 'nil) - ((x) x) - ((x . args) - (let iterate ((x x) (tail args)) - (if (null? tail) - x - (let ((var (gensym))) - `(lexical-let ((,var ,x)) - (if ,var - ,var - ,(iterate (car tail) (cdr tail)))))))))) - -;;; Exception handling. unwind-protect and catch are implemented as -;;; macros (throw is a built-in function). - -;;; catch and throw can mainly be implemented directly using Guile's -;;; primitives for exceptions, the only difficulty is that the keys used -;;; within Guile must be symbols, while elisp allows any value and -;;; checks for matches using eq (eq?). We handle this by using always #t -;;; as key for the Guile primitives and check for matches inside the -;;; handler; if the elisp keys are not eq?, we rethrow the exception. - -(built-in-macro catch - (lambda (tag . body) - (if (null? body) - (macro-error "catch with empty body")) - (let ((tagsym (gensym))) - `(lexical-let ((,tagsym ,tag)) - ((guile-primitive catch) - #t - (lambda () ,@body) - ,(let* ((dummy-key (gensym)) - (elisp-key (gensym)) - (value (gensym)) - (arglist `(,dummy-key ,elisp-key ,value))) - `(with-always-lexical - ,arglist - (lambda ,arglist - (if (eq ,elisp-key ,tagsym) - ,value - ((guile-primitive throw) ,dummy-key ,elisp-key - ,value)))))))))) - -;;; unwind-protect is just some weaker construct as dynamic-wind, so -;;; straight-forward to implement. - -(built-in-macro unwind-protect - (lambda (body . clean-ups) - (if (null? clean-ups) - (macro-error "unwind-protect without cleanup code")) - `((guile-primitive dynamic-wind) - (lambda () nil) - (lambda () ,body) - (lambda () ,@clean-ups)))) - |