summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorBT Templeton <bpt@hcoop.net>2011-06-20 17:23:13 -0400
committerBT Templeton <bpt@hcoop.net>2012-02-03 18:53:48 -0500
commitb652e2b93fbcbc43ac8b1e7d7587904f0bf2bc62 (patch)
tree1c91d1dac90a753f00df22d12dc4cd3ca5c89577
parent80687f2e4b50a41cb3b3ebe0cd5a05d7d71d414c (diff)
downloadguile-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.am1
-rw-r--r--module/language/elisp/boot.el115
-rw-r--r--module/language/elisp/runtime.scm11
-rw-r--r--module/language/elisp/runtime/function-slot.scm19
-rw-r--r--module/language/elisp/runtime/macros.scm144
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))))
-