mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-29 19:30:36 +02:00
Code Activity

remove (lang elisp), as it won't work with the new evaluator

Browse source 
* lang/: Delete. This causes me some pain, but the new elisp compiler is
  coming soon, and the old one really won't work with the new evaluator.
* Makefile.am:
* configure.ac: Autotoolery for elisp removal.
* test-suite/tests/elisp.test: Comment out the body of the elisp test.
  The tests themselves should be useful in the new world, though.
This commit is contained in:
Andy Wingo 2009-11-27 11:37:17 +01:00
parent 8397a3a695
commit c58b8c5aed
42 changed files with 7 additions and 2431 deletions
Download patch file Download diff file Expand all files Collapse all files

2
Makefile.am
View file

@ -25,7 +25,7 @@
AUTOMAKE_OPTIONS = 1.10
SUBDIRS = lib meta libguile guile-readline emacs \
srfi doc examples test-suite benchmark-suite lang am \
srfi doc examples test-suite benchmark-suite am \
module testsuite
include_HEADERS = libguile.h

1
configure.ac
View file

@ -1614,7 +1614,6 @@ AC_CONFIG_FILES([
doc/tutorial/Makefile
emacs/Makefile
examples/Makefile
lang/Makefile
libguile/Makefile
srfi/Makefile
guile-readline/Makefile

69
lang/Makefile.am
View file

@ -1,69 +0,0 @@
## Process this file with automake to produce Makefile.in.
##
## Copyright (C) 2000, 2006, 2009 Free Software Foundation, Inc.
##
## This file is part of GUILE.
##
## GUILE 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, or
## (at your option) any later version.
##
## GUILE 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 GUILE; see the file COPYING.LESSER. If not,
## write to the Free Software Foundation, Inc., 51 Franklin Street,
## Fifth Floor, Boston, MA 02110-1301 USA
AUTOMAKE_OPTIONS = gnu
# These should be installed and distributed.
elisp_sources = \
elisp/base.scm \
elisp/example.el \
elisp/interface.scm \
elisp/transform.scm \
elisp/expand.scm \
elisp/variables.scm \
\
elisp/primitives/buffers.scm \
elisp/primitives/char-table.scm \
elisp/primitives/features.scm \
elisp/primitives/fns.scm \
elisp/primitives/format.scm \
elisp/primitives/guile.scm \
elisp/primitives/keymaps.scm \
elisp/primitives/lists.scm \
elisp/primitives/load.scm \
elisp/primitives/match.scm \
elisp/primitives/numbers.scm \
elisp/primitives/pure.scm \
elisp/primitives/read.scm \
elisp/primitives/signal.scm \
elisp/primitives/strings.scm \
elisp/primitives/symprop.scm \
elisp/primitives/syntax.scm \
elisp/primitives/system.scm \
elisp/primitives/time.scm \
\
elisp/internals/evaluation.scm \
elisp/internals/format.scm \
elisp/internals/fset.scm \
elisp/internals/lambda.scm \
elisp/internals/load.scm \
elisp/internals/null.scm \
elisp/internals/set.scm \
elisp/internals/signal.scm \
elisp/internals/time.scm \
elisp/internals/trace.scm
subpkgdatadir = $(pkgdatadir)/$(GUILE_EFFECTIVE_VERSION)/lang
nobase_subpkgdata_DATA = $(elisp_sources)
TAGS_FILES = $(nobase_subpkgdata_DATA)
EXTRA_DIST = $(elisp_sources) elisp/ChangeLog-2008

401
lang/elisp/ChangeLog-2008
View file

@ -1,401 +0,0 @@
2008-04-14 Neil Jerram <neil@ossau.uklinux.net>
* primitives/symprop.scm (get): Use lambda->nil.
* primitives/strings.scm (aset): New primitive.
* internals/load.scm (load): Use in-vicinity (instead of
string-append) to add a slash if needed.
2004-02-08 Mikael Djurfeldt <djurfeldt@nada.kth.se>
* primitives/Makefile.am (TAGS_FILES), internals/Makefile.am
(TAGS_FILES), Makefile.am (TAGS_FILES): Use this variable instead
of ETAGS_ARGS so that TAGS can be built using separate build
directory.
2003-11-01 Neil Jerram <neil@ossau.uklinux.net>
* internals/format.scm (format), internals/signal.scm (error),
internals/load.scm (load): Export using #:replace to avoid
duplicate binding warnings.
2003-01-05 Marius Vollmer <mvo@zagadka.ping.de>
* primitives/Makefile.am (elisp_sources): Added char-table.scm.
2002-12-28 Neil Jerram <neil@ossau.uklinux.net>
* base.scm (lang): Use char-table module.
* primitives/char-table.scm (lang): New (stub definitions).
2002-12-08 Rob Browning <rlb@defaultvalue.org>
* Makefile.am (subpkgdatadir): VERSION -> GUILE_EFFECTIVE_VERSION.
* primitives/Makefile.am (subpkgdatadir): VERSION ->
GUILE_EFFECTIVE_VERSION.
* internals/Makefile.am (subpkgdatadir): VERSION ->
GUILE_EFFECTIVE_VERSION.
2002-02-13 Neil Jerram <neil@ossau.uklinux.net>
* base.scm (load-emacs): Add optional parameters for specifying an
alternative load path, and for debugging this. (Thanks to
Thien-Thi Nguyen!)
* primitives/syntax.scm (setq): Use `set'.
* internals/set.scm (set): Fixed to support variables that are
imported from other modules.
2002-02-12 Neil Jerram <neil@ossau.uklinux.net>
* transform.scm (scheme): Use set-current-module to ensure
expected behaviour of resolve-module.
2002-02-08 Neil Jerram <neil@ossau.uklinux.net>
* STATUS: New file.
* README: Updated.
* interface.scm (translate-elisp): New exported procedure.
(elisp-function): Symbol var is `obj', not `symbol'.
* internals/lambda.scm, primitives/fns.scm: Fix confusion between
interactive-spec and interactive-specification.
* internals/lambda.scm (transform-lambda), primitives/syntax.scm
(defmacro): Bind unspecified optional and rest arguments to #nil,
not #f.
* internals/null.scm (->nil, lambda->nil): New, exported.
(null): Use ->nil.
* primitives/features.scm (featurep), primitives/fns.scm
(fboundp, subrp): Use ->nil.
* internals/lists.scm (cons, setcdr, memq, member, assq, assoc):
Simplified.
(car, cdr): Return #nil rather than #f.
* primitives/load.scm (current-load-list), primitives/pure.scm
(purify-flag): Set to #nil, not #f.
* primitives/match.scm (string-match): Return #nil rather than #f.
* primitives/numbers.scm (integerp, numberp),
primitives/strings.scm (string-lessp, stringp): Use lambda->nil.
* primitives/symprop.scm (boundp): Use ->nil.
(symbolp, local-variable-if-set-p): Return #nil rather than #f.
* primitives/syntax.scm (prog1, prog2): Mangle variable names
further to lessen possibility of conflicts.
(if, and, or, cond): Return #nil rather than #f.
(cond): Return #t rather than t (which is undefined).
(let, let*): Bind uninitialized variables to #nil, not #f.
* transform.scm: Resolve inconsistency in usage of `map', and add
an explanatory note. Also cleaned up use of subsidiary
transformation functions. Also use cons-source wherever possible.
(transform-datum, transform-quote): New.
(transform-quasiquote): Renamed from `transform-inside-qq'.
(transform-application): Apply `transform-quote' to application
args.
(cars->nil): Removed.
* internals/null.scm (null), primitives/lists.scm (cons, car, cdr,
setcdr, memq, member, assq, assoc, nth): Update to take into
account new libguile support for Elisp nil value.
2002-02-06 Neil Jerram <neil@ossau.uklinux.net>
* example.el (time): New macro, for performance measurement.
Accompanying comment compares results for Guile and Emacs.
* transform.scm (scheme): New macro.
(transformer): New implementation of `scheme' escape that doesn't
rely on (lang elisp base) importing Guile bindings.
* base.scm: No longer import anything from (guile).
(load-emacs): Add scheme form to ensure that keywords
read option is set correctly.
* primitives/syntax.scm (defmacro, let, let*): Unquote uses of
`@bind' in transformed code.
(if): Unquote uses of `nil-cond' in transformed code.
* internals/lambda.scm (transform-lambda): Unquote use of `@bind'
in transformed code.
* transform.scm (transformer-macro): Don't quote `list' in
transformed code.
(transform-application): Don't quote `@fop' in transformed code.
(transformer): No need to treat `@bind' and `@fop' as special
cases in input to the transformer.
2002-02-04 Neil Jerram <neil@ossau.uklinux.net>
* primitives/syntax.scm (parse-formals, transform-lambda,
interactive-spec, set-not-subr!, transform-lambda/interactive):
Move into internals/lambda.scm so that these can also be used
by...
* internals/fset.scm (elisp-apply): Use `eval' and
`transform-lambda/interactive' to turn a quoted lambda expression
into a Scheme procedure.
* transform.scm (m-quasiquote): Don't quote `quasiquote' in
transformed code.
(transformer): Transform '() to #nil.
2002-02-03 Neil Jerram <neil@ossau.uklinux.net>
* internals/Makefile.am (elisp_sources): Add lambda.scm.
* internals/lambda.scm (lang): New file.
2002-02-01 Neil Jerram <neil@ossau.uklinux.net>
* transform.scm (transformer), primitives/syntax.scm (let*):
Unquote uses of `begin' in transformed code.
2002-01-29 Neil Jerram <neil@ossau.uklinux.net>
* transform.scm (transform-1, transform-2, transform-3,
transform-list): Removed (unused).
* transform.scm, primitives/syntax.scm: Add commas everywhere
before use of (guile) primitives in generated code, so that (lang
elisp base) doesn't have to import bindings from (guile).
* base.scm: Move use-modules expressions inside the define-module,
and add #:pure so that we don't import bindings from (guile).
2002-01-25 Neil Jerram <neil@ossau.uklinux.net>
* transform.scm (transform-application): Preserve source
properties of original elisp expression by using cons-source.
* transform.scm: Don't handle special forms specially in the
translator. Instead, define them as macros in ...
* primitives/syntax.scm: New file; special form definitions.
* primitives/fns.scm (run-hooks): Rewritten correctly.
* primitives/symprop.scm (symbol-value): Use `value'.
* internals/set.scm (value): New function.
* primitives/fns.scm: Use (lang elisp internals null), as null is
no longer a primitive. Change generated #f values to %nil.
* internals/null.scm (null): Handle nil symbol.
* primitives/lists.scm (memq, member, assq, assoc): Handle all
possible nil values.
* transform.scm (transformer): Translate `nil' and `t' to #nil and
#t.
* base.scm: Remove setting of 'language read-option.
2001-11-03 Neil Jerram <neil@ossau.uklinux.net>
* README (Resources): Fill in missing URLs.
2001-11-02 Neil Jerram <neil@ossau.uklinux.net>
* Makefile.am (elisp_sources): Added base.scm, example.el,
interface.scm; removed emacs.scm.
* README: Updated accordingly.
* internals/load.scm (load): Avoid using `load-path' if the
supplied file name begins with a slash.
* internals/fset.scm: Support export of defuns, defmacros and
defvars to a module specified by the fluid `elisp-export-module'.
This allows us to automate the importing of Elisp definitions into
Scheme.
* example.el: New file: example code for `load-elisp-file'.
* interface.scm: New file - mechanisms to exchange definitions
between Scheme and Elisp.
Following changes try to make the Elisp evaluation module less
Emacs-dependent; in other words, so that it isn't necessary to try
to load the whole Emacs environment before evaluating basic
non-Emacs-specific Elisp code.
* variables.scm, internals/evaluation.scm: Changed (lang elisp
emacs) to (lang elisp base).
* emacs.scm (lang): Removed.
* base.scm (lang): New file (non-emacs-specific replacement for
emacs.scm).
2001-10-28 Neil Jerram <neil@ossau.uklinux.net>
* primitives/symprop.scm (symbol-name): New primitive.
* primitives/strings.scm (stringp): New primitive.
* primitives/pure.scm (purify-flag): New variable.
* primitives/numbers.scm (numberp): New primitive.
* internals/fset.scm (fset): Set procedure and macro name
properties usefully to match Elisp symbol names. Also bind Elisp
function definition variables to similarly named symbols in the
(lang elisp variables) module.
* transform.scm (transformer, m-unwind-protect): Added support for
`unwind-protect'.
(m-quasiquote): Use 'quasiquote rather than 'quote.
(transform-lambda, m-defmacro): When no rest arguments, set the
rest parameter to '() rather than #f. It shouldn't make any
difference, but it feels more right.
* README: Enlarged description of current status.
* Makefile.am (elisp_sources): Added variables.scm.
* variables.scm: New file.
2001-10-26 Neil Jerram <neil@ossau.uklinux.net>
* buffers.scm, calling.scm: Removed. These should have
disappeared during the reorganization described below, but I
missed them by mistake.
* primitives/symprop.scm (set, boundp, symbol-value): Changed to
use (module-xx the-elisp-module ...) rather than (local-xx ...).
(symbolp): Accept either symbols or keywords.
(set-default, default-boundp, default-value,
local-variable-if-set-p): New.
* primitives/match.scm (string-match, match-data): Store last
match data in Emacs rather than Guile form, to simplify
implementation of ...
(set-match-data, store-match-data): New.
* primitives/load.scm (autoload, current-load-list): New. (But
autoload is just stubbed, not properly implemented.)
* primitives/lists.scm (nth, listp, consp, nconc): New.
* primitives/fns.scm (byte-code-function-p, run-hooks): New.
* transform.scm (transform-application, transformer-macro): New
scheme for transforming procedure arguments while leaving macro
args untransformed. (See also associated change in libguile.)
(m-defconst): Simplified, now uses m-setq.
* Makefile.am: Changed so that it only deals with files directly
in this directory; otherwise files don't install cleanly.
* internals/Makefile.am, primitives/Makefile.am,
internals/.cvsignore, primitives/.cvsignore: New files.
2001-10-26 Neil Jerram <neil@ossau.uklinux.net>
* transform.scm (transformer): New handling for (1) quasiquoting
syntax like "(` ...)" as well as the more normal "` ..."; (2)
`function'; (3) interactive specification in lambda body.
Simplied handling for `setq'.
(transform-inside-qq): Fixed to handle improper as well as proper
lists.
(transform-lambda/interactive): New; wraps transform-lambda to
handle setting of various procedure properties.
(transform-lambda, m-defmacro): Changed `args' and `num-args' to
`%--args' and `%--num-args' in the hope of avoiding lexical
vs. dynamic name clashes.
(m-and): Use #f instead of '() where a condition fails.
Plus big hierarchy reorganization, in which most of the previous
occupants of lang/elisp moved to lang/elisp/primitives, with some
internal processing being split out into lang/elisp/internals.
The upshot looks like this:
* internals/trace.scm, internals/set.scm, internals/load.scm,
internals/fset.scm, internals/signal.scm, internals/time.scm,
internals/format.scm, internals/null.scm,
internals/evaluation.scm, primitives/buffers.scm,
primitives/features.scm, primitives/format.scm,
primitives/time.scm, primitives/guile.scm, primitives/keymaps.scm,
primitives/lists.scm, primitives/load.scm, primitives/match.scm,
primitives/numbers.scm, primitives/pure.scm, primitives/read.scm,
primitives/signal.scm, primitives/strings.scm,
primitives/symprop.scm, primitives/system.scm, primitives/fns.scm:
New files.
* features.scm, format.scm, fset.scm, guile.scm, keymaps.scm,
lists.scm, load.scm, match.scm, numbers.scm, pure.scm, read.scm,
signal.scm, strings.scm, symprop.scm, system.scm, time.scm,
trace.scm: Removed files.
2001-10-23 Neil Jerram <neil@ossau.uklinux.net>
* match.scm (string-match): New implementation using new
`make-emacs-regexp' primitive; old workaround implementation
renamed to `string-match-workaround'.
2001-10-21 Neil Jerram <neil@ossau.uklinux.net>
* transform.scm (m-defun, m-defmacro, m-let, m-defvar,
m-defconst): Use more selective tracing mechanism (provided by new
file trace.scm).
* symprop.scm (get, boundp), transform.scm (transform-lambda,
m-defmacro): Remove unnecessary uses of nil-ify and t-ify.
* match.scm (string-match): Workaround Guile/libc regex
parenthesis bug.
* emacs.scm: Move elisp primitive definitions into more specific
files, so that emacs.scm contains only overall code.
* Makefile.am: Added new files.
* numbers.scm, trace.scm, time.scm, pure.scm, system.scm,
read.scm, calling.scm, guile.scm: New files.
2001-10-20 Neil Jerram <neil@ossau.uklinux.net>
* Makefile.am (elisp_sources): Added match.scm and strings.scm.
* match.scm, strings.scm: New files.
2001-10-19 Neil Jerram <neil@ossau.uklinux.net>
* transform.scm: Replace uses of `nil' by `#f' or `'()'.
* Makefile.am (elisp_sources): Added lists.scm.
* load.scm (the-elisp-module): Corrected (lang elisp emacs) module
name.
* lists.scm (lang): New file containing list-related primitives.
* emacs.scm: Corrected module name.
2001-10-19 Neil Jerram <neil@ossau.uklinux.net>
Initial implementation of an Emacs Lisp translator, based on
transformer code originally written by Mikael Djurfeldt.
* Makefile.am, .cvsignore: New.
* ChangeLog, README, buffers.scm, emacs.scm, features.scm,
format.scm, fset.scm, keymaps.scm, load.scm, signal.scm,
symprop.scm, transform.scm: New files.

303
lang/elisp/README
View file

@ -1,303 +0,0 @@
-*- outline -*-
This directory holds the Scheme side of a translator for Emacs Lisp.
* Usage
To load up the base Elisp environment:
(use-modules (lang elisp base))
Then you can switch into this module
(define-module (lang elisp base))
and start typing away in Elisp, or evaluate an individual Elisp
expression from Scheme:
(eval EXP (resolve-module '(lang elisp base)))
A more convenient, higher-level interface is provided by (lang elisp
interface):
(use-modules (lang elisp interface))
With this interface, you can evaluate an Elisp expression
(eval-elisp EXP)
load an Elisp file with no effect on the Scheme world
(load-elisp-file "/home/neil/Guile/cvs/guile-core/lang/elisp/example.el")
load an Elisp file, automatically importing top level definitions into
Scheme
(use-elisp-file "/home/neil/Guile/cvs/guile-core/lang/elisp/example.el")
export Scheme objects to Elisp
(export-to-elisp + - * my-func 'my-var)
and try to bootstrap a complete Emacs environment:
(load-emacs)
* Status
Please see the STATUS file for the full position.
** Trying to load a complete Emacs environment.
To try this, type `(use-modules (lang elisp interface))' and then
`(load-emacs)'. The following output shows how far I get when I try
this.
guile> (use-modules (lang elisp interface))
guile> (load-emacs)
Calling loadup.el to clothe the bare Emacs...
Loading /usr/share/emacs/20.7/lisp/loadup.el...
Using load-path ("/usr/share/emacs/20.7/lisp/" "/usr/share/emacs/20.7/lisp/emacs-lisp/")
Loading /usr/share/emacs/20.7/lisp/byte-run.el...
Loading /usr/share/emacs/20.7/lisp/byte-run.el...done
Loading /usr/share/emacs/20.7/lisp/subr.el...
Loading /usr/share/emacs/20.7/lisp/subr.el...done
Loading /usr/share/emacs/20.7/lisp/version.el...
Loading /usr/share/emacs/20.7/lisp/version.el...done
Loading /usr/share/emacs/20.7/lisp/map-ynp.el...
Loading /usr/share/emacs/20.7/lisp/map-ynp.el...done
Loading /usr/share/emacs/20.7/lisp/widget.el...
Loading /usr/share/emacs/20.7/lisp/emacs-lisp/cl.el...
Loading /usr/share/emacs/20.7/lisp/emacs-lisp/cl.el...done
Loading /usr/share/emacs/20.7/lisp/widget.el...done
Loading /usr/share/emacs/20.7/lisp/custom.el...
Loading /usr/share/emacs/20.7/lisp/custom.el...done
Loading /usr/share/emacs/20.7/lisp/cus-start.el...
Note, built-in variable `abbrev-all-caps' not bound
... [many other variable not bound messages] ...
Loading /usr/share/emacs/20.7/lisp/cus-start.el...done
Loading /usr/share/emacs/20.7/lisp/international/mule.el...
<unnamed port>: In procedure make-char-table in expression (@fop make-char-table (# #)):
<unnamed port>: Symbol's function definition is void
ABORT: (misc-error)
Type "(backtrace)" to get more information or "(debug)" to enter the debugger.
guile>
That's 3279 lines ("wc -l") of Elisp code already, which isn't bad!
I think that progress beyond this point basically means implementing
multilingual and multibyte strings properly for Guile. Which is a
_lot_ of work and requires IMO a very clear plan for Guile's role with
respect to Emacs.
* Design
When thinking about how to implement an Elisp translator for Guile, it
is important to realize that the great power of Emacs does not arise
from Elisp (seen as a language in syntactic terms) alone, but from the
combination of this language with the collection of primitives
provided by the Emacs C source code. Therefore, to be of practical
use, an Elisp translator needs to be more than just a transformer that
translates sexps to Scheme expressions.
The finished translator should consist of several parts...
** Syntax transformation
Although syntax transformation isn't all we need, we do still need it!
This part is implemented by the (lang elisp transform) module; it is
close to complete and seems to work pretty reliably.
Note that transformed expressions use the `@fop' and `@bind' macros
provided by...
** C support for transformed expressions
For performance and historical reasons (and perhaps necessity - I
haven't thought about it enough yet), some of the transformation
support is written in C.
*** @fop
The `@fop' macro is used to dispatch Elisp applications. Its first
argument is a symbol, and this symbol's function slot is examined to
find a procedure or macro to apply to the remaining arguments. `@fop'
also handles aliasing (`defalias'): in this case the function slot
contains another symbol.
Once `@fop' has found the appropriate procedure or macro to apply, it
returns an application expression in which that procedure or macro
replaces the `@fop' and the original symbol. Hence no Elisp-specific
evaluator support is required to perform the application.
*** @bind
Currently, Elisp variables are the same as Scheme variables, so
variable references are effectively untransformed.
The `@bind' macro does Elisp-style dynamic variable binding.
Basically, it locates the named top level variables, `set!'s them to
new values, evaluates its body, and then uses `set!' again to restore
the original values.
Because of the body evaluation, `@bind' requires evaluator support.
In fact, the `@bind' macro code does little more than replace itself
with the memoized SCM_IM_BIND. Most of the work is done by the
evaluator when it hits SCM_IM_BIND.
One theoretical problem with `@bind' is that any local Scheme variable
in the same scope and with the same name as an Elisp variable will
shadow the Elisp variable. But in practice it's difficult to set up
such a situation; an exception is the translator code itself, so there
we mangle the relevant Scheme variable names a bit to avoid the
problem.
Other possible problems with this approach are that it might not be
possible to implement buffer local variables properly, and that
`@bind' might become too inefficient when we implement full support
for undefining Scheme variables. So we might in future have to
transform Elisp variable references after all.
*** Truth value stuff
Following extensive discussions on the Guile mailing list between
September 2001 and January 2002, we decided to go with Jim Blandy's
proposal. See devel/translation/lisp-and-scheme.text for details.
- The Elisp nil value is a new immediate SCM_MAKIFLAG, eq?-distinct
from both #f and '() (and of course any other Scheme value). It can
be accessed via the (guile) binding `%nil', and prints as `#nil'.
- All Elisp primitives treat #nil, #f and '() as identical.
- Scheme truth-testing primitives have been modified so that they
treat #nil the same as #f.
- Scheme list-manipulating primitives have been modified so that they
treat #nil the same as '().
- The Elisp t value is the same as #t.
** Emacs editing primitives
Buffers, keymaps, text properties, windows, frames etc. etc.
Basically, everything that is implemented as a primitive in the Emacs
C code needs to be implemented either in Scheme or in C for Guile.
The Scheme files in the primitives subdirectory implement some of
these primitives in Scheme. Not because that is the right decision,
but because this is a proof of concept and it's quicker to write badly
performing code in Scheme.
Ultimately, most of these primitive definitions should really come
from the Emacs C code itself, translated or preprocessed in a way that
makes it compile with Guile. I think this is pretty close to the work
that Ken Raeburn has been doing on the Emacs codebase.
** Reading and printing support
Elisp is close enough to Scheme that it's convenient to coopt the
existing Guile reader rather than to write a new one from scratch, but
there are a few syntactic differences that will require changes in
reading and printing. None of the following changes has yet been
implemented.
- Character syntax is `?a' rather than `#\a'. (Not done. More
precisely, `?a' in Elisp isn't character syntax but an alternative
integer syntax. Note that we could support most of the `?a' syntax
simply by doing
(define ?a (char->integer #\a)
(define ?b (char->integer #\b)
and so on.)
- Vector syntax is `[1 2 3]' rather than `#(1 2 3)'.
- When in an Elisp environment, #nil and #t should print as `nil' and
`t'.
** The Elisp evaluation module (lang elisp base)
Fundamentally, Guile's module system can't be used to package Elisp
code in the same way it is used for Scheme code, because Elisp
function definitions are stored as symbol properties (in the symbol's
"function slot") and so are global. On the other hand, it is useful
(necessary?) to associate some particular module with Elisp evaluation
because
- Elisp variables are currently implemented as Scheme variables and so
need to live in some module
- a syntax transformer is a property of a module.
Therefore we have the (lang elisp base) module, which acts as the
repository for all Elisp variables and the site of all Elisp
evaluation.
The initial environment provided by this module is intended to be a
non-Emacs-dependent subset of Elisp. To get the idea, imagine someone
who wants to write an extension function for, say Gnucash, and simply
prefers to write in Elisp rather than in Scheme. He/she therefore
doesn't buffers, keymaps and so on, just the basic language syntax and
core data functions like +, *, concat, length etc., plus specific
functions made available by Gnucash.
(lang elisp base) achieves this by
- importing Scheme definitions for some Emacs primitives from the
files in the primitives subdirectory
- then switching into Elisp syntax.
After this point, `(eval XXX (resolve-module '(lang elisp base)))'
will evaluate XXX as an Elisp expression in the (lang elisp base)
module. (`eval-elisp' in (lang elisp interface) is a more convenient
wrapper for this.)
** Full Emacs environment
The difference between the initial (lang elisp base) environment and a
fully loaded Emacs equivalent is
- more primitives: buffers, char-tables and many others
- the bootstrap Elisp code that an undumped Emacs loads during
installation by calling `(load "loadup.el")'.
We don't have all the missing primitives, but we can already get
through some of loadup.el. The Elisp function `load-emacs' (defined
in (lang elisp base) initiates the loading of loadup.el; (lang elisp
interface) exports `load-emacs' to Scheme.
`load-emacs' loads so much Elisp code that it's an excellent way to
test the translator. In current practice, it runs for a while and
then fails when it gets to an undefined primitive or a bug in the
translator. Eventually, it should go all the way. (And then we can
worry about adding unexec support to Guile!) For the output that
currently results from calling `(load-emacs)', see above in the Status
section.
* Resources
** Ken Raeburn's Guile Emacs page
http://www.mit.edu/~raeburn/guilemacs/
** Keisuke Nishida's Gemacs project
http://gemacs.sourceforge.net
** Jim Blandy's nil/#f/() notes
http://sanpietro.red-bean.com/guile/guile/old/3114.html
Also now stored as guile-core/devel/translation/lisp-and-scheme.text
in Guile CVS.
** Mikael Djurfeldt's notes on translation
See file guile-core/devel/translation/langtools.text in Guile CVS.

35
lang/elisp/STATUS
View file

@ -1,35 +0,0 @@
-*-text-*-
I've now finished my currently planned work on the Emacs Lisp
translator in guile-core CVS.
It works well enough for experimentation and playing around with --
see the README file for details of what it _can_ do -- but has two
serious restrictions:
- Most Emacs Lisp primitives are not yet implemented. In particular,
there are no buffer-related primitives.
- Performance compares badly with Emacs. Using a handful of
completely unscientific tests, I found that Guile was between 2 and
20 times slower than Emacs. (See the comment in
lang/elisp/example.el for details of tests and results.)
Interestingly, both these restrictions point in the same direction:
the way forward is to define the primitives by compiling a
preprocessed version of the Emacs source code, not by trying to
implement them in Scheme. (Which, of course, is what Ken Raeburn's
project is already trying to do.)
Given this conclusion, I expect that most of the translator's Scheme
code will eventually become obsolete, replaced by bits of Emacs C
code. Until then, though, it should have a role:
- as a guide to the Guile Emacs project on how to interface to the
Elisp support in libguile (notably, usage of `@fop' and `@bind')
- as a proof of concept and fun thing to experiment with
- as a working translator that could help us develop our picture of
how we want to integrate translator usage in general with the rest
of Guile.

48
lang/elisp/base.scm
View file

@ -1,48 +0,0 @@
(define-module (lang elisp base)
;; Be pure. Nothing in this module requires symbols that map to the
;; standard Guile builtins, and it creates a problem if this module
;; has access to them, as @bind can dynamically change their values.
;; Transformer output always uses the values of builtin procedures
;; and macros directly.
#:pure
;; {Elisp Primitives}
;;
;; In other words, Scheme definitions of elisp primitives. This
;; should (ultimately) include everything that Emacs defines in C.
#:use-module (lang elisp primitives buffers)
#:use-module (lang elisp primitives char-table)
#:use-module (lang elisp primitives features)
#:use-module (lang elisp primitives format)
#:use-module (lang elisp primitives fns)
#:use-module (lang elisp primitives guile)
#:use-module (lang elisp primitives keymaps)
#:use-module (lang elisp primitives lists)
#:use-module (lang elisp primitives load)
#:use-module (lang elisp primitives match)
#:use-module (lang elisp primitives numbers)
#:use-module (lang elisp primitives pure)
#:use-module (lang elisp primitives read)
#:use-module (lang elisp primitives signal)
#:use-module (lang elisp primitives strings)
#:use-module (lang elisp primitives symprop)
#:use-module (lang elisp primitives syntax)
#:use-module (lang elisp primitives system)
#:use-module (lang elisp primitives time)
;; Now switch into Emacs Lisp syntax.
#:use-syntax (lang elisp transform))
;;; Everything below here is written in Elisp.
(defun load-emacs (&optional new-load-path debug)
(if debug (message "load-path: %s" load-path))
(cond (new-load-path
(message "Setting load-path to: %s" new-load-path)
(setq load-path new-load-path)))
(if debug (message "load-path: %s" load-path))
(scheme (read-set! keywords 'prefix))
(message "Calling loadup.el to clothe the bare Emacs...")
(load "loadup.el")
(message "Guile Emacs now fully clothed"))

39
lang/elisp/example.el
View file

@ -1,39 +0,0 @@
(defun html-page (title &rest contents)
(concat "<HTML>\n"
"<HEAD>\n"
"<TITLE>" title "</TITLE>\n"
"</HEAD>\n"
"<BODY>\n"
(apply 'concat contents)
"</BODY>\n"
"</HTML>\n"))
(defmacro time (repeat-count &rest body)
`(let ((count ,repeat-count)
(beg (current-time))
end)
(while (> count 0)
(setq count (- count 1))
,@body)
(setq end (current-time))
(+ (* 1000000.0 (+ (* 65536.0 (- (car end) (car beg)))
(- (cadr end) (cadr beg))))
(* 1.0 (- (caddr end) (caddr beg))))))
;Non-scientific performance measurements (Guile measurements are with
;`guile -q --no-debug'):
;
;(time 100000 (+ 3 4))
; => 225,071 (Emacs) 4,000,000 (Guile)
;(time 100000 (lambda () 1))
; => 2,410,456 (Emacs) 4,000,000 (Guile)
;(time 100000 (apply 'concat (mapcar (lambda (s) (concat s "." s)) '("a" "b" "c" "d"))))
; => 10,185,792 (Emacs) 136,000,000 (Guile)
;(defun sc (s) (concat s "." s))
;(time 100000 (apply 'concat (mapcar 'sc '("a" "b" "c" "d"))))
; => 7,870,055 (Emacs) 26,700,000 (Guile)
;
;Sadly, it looks like the translator's performance sucks quite badly
;when compared with Emacs. But the translator is still very new, so
;there's probably plenty of room of improvement.

4
lang/elisp/expand.scm
View file

@ -1,4 +0,0 @@
(define-module (lang elisp expand)
#:export (expand))
(define (expand x) x)

140
lang/elisp/interface.scm
View file

@ -1,140 +0,0 @@
(define-module (lang elisp interface)
#:use-syntax (lang elisp expand)
#:use-module (lang elisp internals evaluation)
#:use-module (lang elisp internals fset)
#:use-module ((lang elisp internals load) #:select ((load . elisp:load)))
#:use-module ((lang elisp transform) #:select (transformer))
#:export (eval-elisp
translate-elisp
elisp-function
elisp-variable
load-elisp-file
load-elisp-library
use-elisp-file
use-elisp-library
export-to-elisp
load-emacs))
;;; This file holds my ideas for the mechanisms that would be useful
;;; to exchange definitions between Scheme and Elisp.
(define (eval-elisp x)
"Evaluate the Elisp expression @var{x}."
(save-module-excursion
(lambda ()
(set-current-module the-elisp-module)
(primitive-eval x))))
(define (translate-elisp x)
"Translate the Elisp expression @var{x} to equivalent Scheme code."
(transformer x))
(define (elisp-function sym)
"Return the procedure or macro that implements @var{sym} in Elisp.
If @var{sym} has no Elisp function definition, return @code{#f}."
(fref sym))
(define (elisp-variable sym)
"Return the variable that implements @var{sym} in Elisp.
If @var{sym} has no Elisp variable definition, return @code{#f}."
(module-variable the-elisp-module sym))
(define (load-elisp-file file-name)
"Load @var{file-name} into the Elisp environment.
@var{file-name} is assumed to name a file containing Elisp code."
;; This is the same as Elisp's `load-file', so use that if it is
;; available, otherwise duplicate the definition of `load-file' from
;; files.el.
(let ((load-file (elisp-function 'load-file)))
(if load-file
(load-file file-name)
(elisp:load file-name #f #f #t))))
(define (load-elisp-library library)
"Load library @var{library} into the Elisp environment.
@var{library} should name an Elisp code library that can be found in
one of the directories of @code{load-path}."
;; This is the same as Elisp's `load-file', so use that if it is
;; available, otherwise duplicate the definition of `load-file' from
;; files.el.
(let ((load-library (elisp-function 'load-library)))
(if load-library
(load-library library)
(elisp:load library))))
(define export-module-name
(let ((counter 0))
(lambda ()
(set! counter (+ counter 1))
(list 'lang 'elisp
(string->symbol (string-append "imports:"
(number->string counter)))))))
(define use-elisp-file
(procedure->memoizing-macro
(lambda (exp env)
"Load Elisp code file @var{file-name} and import its definitions
into the current Scheme module. If any @var{imports} are specified,
they are interpreted as selection and renaming specifiers as per
@code{use-modules}."
(let ((file-name (cadr exp))
(env (cddr exp)))
(let ((export-module-name (export-module-name)))
`(begin
(fluid-set! ,elisp-export-module (resolve-module ',export-module-name))
(beautify-user-module! (resolve-module ',export-module-name))
(load-elisp-file ,file-name)
(use-modules (,export-module-name ,@imports))
(fluid-set! ,elisp-export-module #f)))))))
(define use-elisp-library
(procedure->memoizing-macro
(lambda (exp env)
"Load Elisp library @var{library} and import its definitions into
the current Scheme module. If any @var{imports} are specified, they
are interpreted as selection and renaming specifiers as per
@code{use-modules}."
(let ((library (cadr exp))
(env (cddr exp)))
(let ((export-module-name (export-module-name)))
`(begin
(fluid-set! ,elisp-export-module (resolve-module ',export-module-name))
(beautify-user-module! (resolve-module ',export-module-name))
(load-elisp-library ,library)
(use-modules (,export-module-name ,@imports))
(fluid-set! ,elisp-export-module #f)))))))
(define (export-to-elisp . defs)
"Export procedures and variables specified by @var{defs} to Elisp.
Each @var{def} is either an object, in which case that object must be
a named procedure or macro and is exported to Elisp under its Scheme
name; or a symbol, in which case the variable named by that symbol is
exported under its Scheme name; or a pair @var{(obj . name)}, in which
case @var{obj} must be a procedure, macro or symbol as already
described and @var{name} specifies the name under which that object is
exported to Elisp."
(for-each (lambda (def)
(let ((obj (if (pair? def) (car def) def))
(name (if (pair? def) (cdr def) #f)))
(cond ((procedure? obj)
(or name
(set! name (procedure-name obj)))
(if name
(fset name obj)
(error "No procedure name specified or deducible:" obj)))
((macro? obj)
(or name
(set! name (macro-name obj)))
(if name
(fset name obj)
(error "No macro name specified or deducible:" obj)))
((symbol? obj)
(or name
(set! name obj))
(module-add! the-elisp-module name
(module-ref (current-module) obj)))
(else
(error "Can't export this kind of object to Elisp:" obj)))))
defs))
(define load-emacs (elisp-function 'load-emacs))

13
lang/elisp/internals/evaluation.scm
View file

@ -1,13 +0,0 @@
(define-module (lang elisp internals evaluation)
#:export (the-elisp-module))
;;;; {Elisp Evaluation}
;;;; All elisp evaluation happens within the same module - namely
;;;; (lang elisp base). This is necessary both because elisp itself
;;;; has no concept of different modules - reflected for example in
;;;; its single argument `eval' function - and because Guile's current
;;;; implementation of elisp stores elisp function definitions in
;;;; slots in global symbol objects.
(define the-elisp-module (resolve-module '(lang elisp base)))

62
lang/elisp/internals/format.scm
View file

@ -1,62 +0,0 @@
(define-module (lang elisp internals format)
#:pure
#:use-module (ice-9 r5rs)
#:use-module ((ice-9 format) #:select ((format . scheme:format)))
#:use-module (lang elisp internals fset)
#:use-module (lang elisp internals signal)
#:replace (format)
#:export (message))
(define (format control-string . args)
(define (cons-string str ls)
(let loop ((sl (string->list str))
(ls ls))
(if (null? sl)
ls
(loop (cdr sl) (cons (car sl) ls)))))
(let loop ((input (string->list control-string))
(args args)
(output '())
(mid-control #f))
(if (null? input)
(if mid-control
(error "Format string ends in middle of format specifier")
(list->string (reverse output)))
(if mid-control
(case (car input)
((#\%)
(loop (cdr input)
args
(cons #\% output)
#f))
(else
(loop (cdr input)
(cdr args)
(cons-string (case (car input)
((#\s) (scheme:format #f "~A" (car args)))
((#\d) (number->string (car args)))
((#\o) (number->string (car args) 8))
((#\x) (number->string (car args) 16))
((#\e) (number->string (car args))) ;FIXME
((#\f) (number->string (car args))) ;FIXME
((#\g) (number->string (car args))) ;FIXME
((#\c) (let ((a (car args)))
(if (char? a)
(string a)
(string (integer->char a)))))
((#\S) (scheme:format #f "~S" (car args)))
(else
(error "Invalid format operation %%%c" (car input))))
output)
#f)))
(case (car input)
((#\%)
(loop (cdr input) args output #t))
(else
(loop (cdr input) args (cons (car input) output) #f)))))))
(define (message control-string . args)
(display (apply format control-string args))
(newline))

113
lang/elisp/internals/fset.scm
View file

@ -1,113 +0,0 @@
(define-module (lang elisp internals fset)
#:use-module (lang elisp internals evaluation)
#:use-module (lang elisp internals lambda)
#:use-module (lang elisp internals signal)
#:export (fset
fref
fref/error-if-void
elisp-apply
interactive-specification
not-subr?
elisp-export-module))
(define the-variables-module (resolve-module '(lang elisp variables)))
;; By default, Guile GC's unreachable symbols. So we need to make
;; sure they stay reachable!
(define syms '())
;; elisp-export-module, if non-#f, holds a module to which definitions
;; should be exported under their normal symbol names. This is used
;; when importing Elisp definitions into Scheme.
(define elisp-export-module (make-fluid))
;; Store the procedure, macro or alias symbol PROC in SYM's function
;; slot.
(define (fset sym proc)
(or (memq sym syms)
(set! syms (cons sym syms)))
(let ((vcell (symbol-fref sym))
(vsym #f)
(export-module (fluid-ref elisp-export-module)))
;; Playing around with variables and name properties... For the
;; reasoning behind this, see the commentary in (lang elisp
;; variables).
(cond ((procedure? proc)
;; A procedure created from Elisp will already have a name
;; property attached, with value of the form
;; <elisp-defun:NAME> or <elisp-lambda>. Any other
;; procedure coming through here must be an Elisp primitive
;; definition, so we give it a name of the form
;; <elisp-subr:NAME>.
(or (procedure-name proc)
(set-procedure-property! proc
'name
(symbol-append '<elisp-subr: sym '>)))
(set! vsym (procedure-name proc)))
((macro? proc)
;; Macros coming through here must be defmacros, as all
;; primitive special forms are handled directly by the
;; transformer.
(set-procedure-property! (macro-transformer proc)
'name
(symbol-append '<elisp-defmacro: sym '>))
(set! vsym (procedure-name (macro-transformer proc))))
(else
;; An alias symbol.
(set! vsym (symbol-append '<elisp-defalias: sym '>))))
;; This is the important bit!
(if (variable? vcell)
(variable-set! vcell proc)
(begin
(set! vcell (make-variable proc))
(symbol-fset! sym vcell)
;; Playing with names and variables again - see above.
(module-add! the-variables-module vsym vcell)
(module-export! the-variables-module (list vsym))))
;; Export variable to the export module, if non-#f.
(if (and export-module
(or (procedure? proc)
(macro? proc)))
(begin
(module-add! export-module sym vcell)
(module-export! export-module (list sym))))))
;; Retrieve the procedure or macro stored in SYM's function slot.
;; Note the asymmetry w.r.t. fset: if fref finds an alias symbol, it
;; recursively calls fref on that symbol. Returns #f if SYM's
;; function slot doesn't contain a valid definition.
(define (fref sym)
(let ((var (symbol-fref sym)))
(if (and var (variable? var))
(let ((proc (variable-ref var)))
(cond ((symbol? proc)
(fref proc))
(else
proc)))
#f)))
;; Same as fref, but signals an Elisp error if SYM's function
;; definition is void.
(define (fref/error-if-void sym)
(or (fref sym)
(signal 'void-function (list sym))))
;; Maps a procedure to its (interactive ...) spec.
(define interactive-specification (make-object-property))
;; Maps a procedure to #t if it is NOT a built-in.
(define not-subr? (make-object-property))
(define (elisp-apply function . args)
(apply apply
(cond ((symbol? function)
(fref/error-if-void function))
((procedure? function)
function)
((and (pair? function)
(eq? (car function) 'lambda))
(eval (transform-lambda/interactive function '<elisp-lambda>)
the-root-module))
(else
(signal 'invalid-function (list function))))
args))

109
lang/elisp/internals/lambda.scm
View file

@ -1,109 +0,0 @@
(define-module (lang elisp internals lambda)
#:use-syntax (lang elisp expand)
#:use-module (lang elisp internals fset)
#:use-module (lang elisp transform)
#:export (parse-formals
transform-lambda/interactive
interactive-spec))
;;; Parses a list of elisp formals, e.g. (x y &optional b &rest r) and
;;; returns three values: (i) list of symbols for required arguments,
;;; (ii) list of symbols for optional arguments, (iii) rest symbol, or
;;; #f if there is no rest argument.
(define (parse-formals formals)
(letrec ((do-required
(lambda (required formals)
(if (null? formals)
(values (reverse required) '() #f)
(let ((next-sym (car formals)))
(cond ((not (symbol? next-sym))
(error "Bad formals (non-symbol in required list)"))
((eq? next-sym '&optional)
(do-optional required '() (cdr formals)))
((eq? next-sym '&rest)
(do-rest required '() (cdr formals)))
(else
(do-required (cons next-sym required)
(cdr formals))))))))
(do-optional
(lambda (required optional formals)
(if (null? formals)
(values (reverse required) (reverse optional) #f)
(let ((next-sym (car formals)))
(cond ((not (symbol? next-sym))
(error "Bad formals (non-symbol in optional list)"))
((eq? next-sym '&rest)
(do-rest required optional (cdr formals)))
(else
(do-optional required
(cons next-sym optional)
(cdr formals))))))))
(do-rest
(lambda (required optional formals)
(if (= (length formals) 1)
(let ((next-sym (car formals)))
(if (symbol? next-sym)
(values (reverse required) (reverse optional) next-sym)
(error "Bad formals (non-symbol rest formal)")))
(error "Bad formals (more than one rest formal)")))))
(do-required '() (cond ((list? formals)
formals)
((symbol? formals)
(list '&rest formals))
(else
(error "Bad formals (not a list or a single symbol)"))))))
(define (transform-lambda exp)
(call-with-values (lambda () (parse-formals (cadr exp)))
(lambda (required optional rest)
(let ((num-required (length required))
(num-optional (length optional)))
`(,lambda %--args
(,let ((%--num-args (,length %--args)))
(,cond ((,< %--num-args ,num-required)
(,error "Wrong number of args (not enough required args)"))
,@(if rest
'()
`(((,> %--num-args ,(+ num-required num-optional))
(,error "Wrong number of args (too many args)"))))
(else
(, @bind ,(append (map (lambda (i)
(list (list-ref required i)
`(,list-ref %--args ,i)))
(iota num-required))
(map (lambda (i)
(let ((i+nr (+ i num-required)))
(list (list-ref optional i)
`(,if (,> %--num-args ,i+nr)
(,list-ref %--args ,i+nr)
,%nil))))
(iota num-optional))
(if rest
(list (list rest
`(,if (,> %--num-args
,(+ num-required
num-optional))
(,list-tail %--args
,(+ num-required
num-optional))
,%nil)))
'()))
,@(map transformer (cddr exp)))))))))))
(define (set-not-subr! proc boolean)
(set! (not-subr? proc) boolean))
(define (transform-lambda/interactive exp name)
(fluid-set! interactive-spec #f)
(let* ((x (transform-lambda exp))
(is (fluid-ref interactive-spec)))
`(,let ((%--lambda ,x))
(,set-procedure-property! %--lambda (,quote name) (,quote ,name))
(,set-not-subr! %--lambda #t)
,@(if is
`((,set! (,interactive-specification %--lambda) (,quote ,is)))
'())
%--lambda)))
(define interactive-spec (make-fluid))

44
lang/elisp/internals/load.scm
View file

@ -1,44 +0,0 @@
(define-module (lang elisp internals load)
#:use-module (ice-9 optargs)
#:use-module (lang elisp internals signal)
#:use-module (lang elisp internals format)
#:use-module (lang elisp internals evaluation)
#:replace (load)
#:export (load-path))
(define load-path '("/usr/share/emacs/20.7/lisp/"
"/usr/share/emacs/20.7/lisp/emacs-lisp/"))
(define* (load file #:optional noerror nomessage nosuffix must-suffix)
(define (load1 filename)
(let ((pathname (let loop ((dirs (if (char=? (string-ref filename 0) #\/)
'("")
load-path)))
(cond ((null? dirs) #f)
((file-exists? (in-vicinity (car dirs) filename))
(in-vicinity (car dirs) filename))
(else (loop (cdr dirs)))))))
(if pathname
(begin
(or nomessage
(message "Loading %s..." pathname))
(with-input-from-file pathname
(lambda ()
(let loop ((form (read)))
(or (eof-object? form)
(begin
;; Note that `eval' already incorporates use
;; of the specified module's transformer.
(eval form the-elisp-module)
(loop (read)))))))
(or nomessage
(message "Loading %s...done" pathname))
#t)
#f)))
(or (and (not nosuffix)
(load1 (string-append file ".el")))
(and (not must-suffix)
(load1 file))
noerror
(signal 'file-error
(list "Cannot open load file" file))))

13
lang/elisp/internals/null.scm
View file

@ -1,13 +0,0 @@
(define-module (lang elisp internals null)
#:export (->nil lambda->nil null))
(define (->nil x)
(or x %nil))
(define (lambda->nil proc)
(lambda args
(->nil (apply proc args))))
(define (null obj)
(->nil (or (not obj)
(null? obj))))

20
lang/elisp/internals/set.scm
View file

@ -1,20 +0,0 @@
(define-module (lang elisp internals set)
#:use-module (lang elisp internals evaluation)
#:use-module (lang elisp internals signal)
#:export (set value))
;; Set SYM's variable value to VAL, and return VAL.
(define (set sym val)
(if (module-defined? the-elisp-module sym)
(module-set! the-elisp-module sym val)
(module-define! the-elisp-module sym val))
val)
;; Return SYM's variable value. If it has none, signal an error if
;; MUST-EXIST is true, just return #nil otherwise.
(define (value sym must-exist)
(if (module-defined? the-elisp-module sym)
(module-ref the-elisp-module sym)
(if must-exist
(error "Symbol's value as variable is void:" sym)
%nil)))

18
lang/elisp/internals/signal.scm
View file

@ -1,18 +0,0 @@
(define-module (lang elisp internals signal)
#:use-module (lang elisp internals format)
#:replace (error)
#:export (signal
wta))
(define (signal error-symbol data)
(scm-error 'elisp-signal
#f
"Signalling ~A with data ~S"
(list error-symbol data)
#f))
(define (error . args)
(signal 'error (list (apply format args))))
(define (wta expected actual pos)
(signal 'wrong-type-argument (list expected actual)))

14
lang/elisp/internals/time.scm
View file

@ -1,14 +0,0 @@
(define-module (lang elisp internals time)
#:use-module (ice-9 optargs)
#:export (format-time-string))
(define* (format-time-string format-string #:optional time universal)
(strftime format-string
((if universal gmtime localtime)
(if time
(+ (ash (car time) 16)
(let ((time-cdr (cdr time)))
(if (pair? time-cdr)
(car time-cdr)
time-cdr)))
(current-time)))))

28
lang/elisp/internals/trace.scm
View file

@ -1,28 +0,0 @@
(define-module (lang elisp internals trace)
#:export (trc trc-syms trc-all trc-none))
(define *syms* #f)
(define (trc-syms . syms)
(set! *syms* syms))
(define (trc-all)
(set! *syms* #f))
(define (trc-none)
(set! *syms* '()))
(define (trc . args)
(let ((sym (car args))
(args (cdr args)))
(if (or (and *syms*
(memq sym *syms*))
(not *syms*))
(begin
(write sym)
(display ": ")
(write args)
(newline)))))
;; Default to no tracing.
(trc-none)

16
lang/elisp/primitives/buffers.scm
View file

@ -1,16 +0,0 @@
(define-module (lang elisp primitives buffers)
#:use-module (ice-9 optargs)
#:use-module (lang elisp internals fset))
(fset 'buffer-disable-undo
(lambda* (#:optional buffer)
'unimplemented))
(fset 're-search-forward
(lambda* (regexp #:optional bound noerror count)
'unimplemented))
(fset 're-search-backward
(lambda* (regexp #:optional bound noerror count)
'unimplemented))

24
lang/elisp/primitives/char-table.scm
View file

@ -1,24 +0,0 @@
(define-module (lang elisp primitives char-table)
#:use-module (lang elisp internals fset)
#:use-module (lang elisp internals null)
#:use-module (ice-9 optargs))
(fset 'make-char-table
(lambda* (purpose #:optional init)
"Return a newly created char-table, with purpose PURPOSE.
Each element is initialized to INIT, which defaults to nil.
PURPOSE should be a symbol which has a `char-table-extra-slots' property.
The property's value should be an integer between 0 and 10."
(list purpose (vector init))))
(fset 'define-charset
(lambda (charset-id charset-symbol info-vector)
(list 'charset charset-id charset-symbol info-vector)))
(fset 'setup-special-charsets
(lambda ()
'unimplemented))
(fset 'make-char-internal
(lambda ()
'unimplemented))

26
lang/elisp/primitives/features.scm
View file

@ -1,26 +0,0 @@
(define-module (lang elisp primitives features)
#:use-module (lang elisp internals fset)
#:use-module (lang elisp internals load)
#:use-module (lang elisp internals null)
#:use-module (ice-9 optargs))
(define-public features '())
(fset 'provide
(lambda (feature)
(or (memq feature features)
(set! features (cons feature features)))))
(fset 'featurep
(lambda (feature)
(->nil (memq feature features))))
(fset 'require
(lambda* (feature #:optional file-name noerror)
(or (memq feature features)
(load (or file-name
(symbol->string feature))
noerror
#f
#f
#t))))

46
lang/elisp/primitives/fns.scm
View file

@ -1,46 +0,0 @@
(define-module (lang elisp primitives fns)
#:use-module (lang elisp internals set)
#:use-module (lang elisp internals fset)
#:use-module (lang elisp internals null))
(fset 'fset fset)
(fset 'defalias fset)
(fset 'apply elisp-apply)
(fset 'funcall
(lambda (function . args)
(elisp-apply function args)))
(fset 'interactive-p
(lambda ()
%nil))
(fset 'commandp
(lambda (sym)
(if (interactive-specification (fref sym)) #t %nil)))
(fset 'fboundp
(lambda (sym)
(->nil (variable? (symbol-fref sym)))))
(fset 'symbol-function fref/error-if-void)
;; FIXME -- lost in the syncase conversion
;; (fset 'macroexpand macroexpand)
(fset 'subrp
(lambda (obj)
(->nil (not (not-subr? obj)))))
(fset 'byte-code-function-p
(lambda (object)
%nil))
(fset 'run-hooks
(lambda hooks
(for-each (lambda (hooksym)
(for-each (lambda (fn)
(elisp-apply fn '()))
(value hooksym #f)))
hooks)))

6
lang/elisp/primitives/format.scm
View file

@ -1,6 +0,0 @@
(define-module (lang elisp primitives format)
#:use-module (lang elisp internals format)
#:use-module (lang elisp internals fset))
(fset 'format format)
(fset 'message message)

20
lang/elisp/primitives/guile.scm
View file

@ -1,20 +0,0 @@
(define-module (lang elisp primitives guile)
#:use-module (lang elisp internals fset))
;;; {Importing Guile procedures into Elisp}
;; It may be worthwhile to import some Guile procedures into the Elisp
;; environment. For now, though, we don't do this.
(if #f
(let ((accessible-procedures
(apropos-fold (lambda (module name var data)
(cons (cons name var) data))
'()
""
(apropos-fold-accessible (current-module)))))
(for-each (lambda (name var)
(if (procedure? var)
(fset name var)))
(map car accessible-procedures)
(map cdr accessible-procedures))))

26
lang/elisp/primitives/keymaps.scm
View file

@ -1,26 +0,0 @@
(define-module (lang elisp primitives keymaps)
#:use-module (lang elisp internals fset))
(define (make-sparse-keymap)
(list 'keymap))
(define (define-key keymap key def)
(set-cdr! keymap
(cons (cons key def) (cdr keymap))))
(define global-map (make-sparse-keymap))
(define esc-map (make-sparse-keymap))
(define ctl-x-map (make-sparse-keymap))
(define ctl-x-4-map (make-sparse-keymap))
(define ctl-x-5-map (make-sparse-keymap))
;;; {Elisp Exports}
(fset 'make-sparse-keymap make-sparse-keymap)
(fset 'define-key define-key)
(export global-map
esc-map
ctl-x-map
ctl-x-4-map
ctl-x-5-map)

103
lang/elisp/primitives/lists.scm
View file

@ -1,103 +0,0 @@
(define-module (lang elisp primitives lists)
#:use-module (lang elisp internals fset)
#:use-module (lang elisp internals null)
#:use-module (lang elisp internals signal))
(fset 'cons cons)
(fset 'null null)
(fset 'not null)
(fset 'car
(lambda (l)
(if (null l)
%nil
(car l))))
(fset 'cdr
(lambda (l)
(if (null l)
%nil
(cdr l))))
(fset 'eq
(lambda (x y)
(or (eq? x y)
(and (null x) (null y)))))
(fset 'equal
(lambda (x y)
(or (equal? x y)
(and (null x) (null y)))))
(fset 'setcar set-car!)
(fset 'setcdr set-cdr!)
(for-each (lambda (sym proc)
(fset sym
(lambda (elt list)
(if (null list)
%nil
(if (null elt)
(let loop ((l list))
(cond ((null l) %nil)
((null (car l)) l)
(else (loop (cdr l)))))
(proc elt list))))))
'( memq member assq assoc)
`(,memq ,member ,assq ,assoc))
(fset 'length
(lambda (x)
(cond ((null x) 0)
((pair? x) (length x))
((vector? x) (vector-length x))
((string? x) (string-length x))
(else (wta 'sequencep x 1)))))
(fset 'copy-sequence
(lambda (x)
(cond ((list? x) (list-copy x))
((vector? x) (error "Vector copy not yet implemented"))
((string? x) (string-copy x))
(else (wta 'sequencep x 1)))))
(fset 'elt
(lambda (obj i)
(cond ((pair? obj) (list-ref obj i))
((vector? obj) (vector-ref obj i))
((string? obj) (char->integer (string-ref obj i))))))
(fset 'list list)
(fset 'mapcar
(lambda (function sequence)
(map (lambda (elt)
(elisp-apply function (list elt)))
(cond ((null sequence) '())
((list? sequence) sequence)
((vector? sequence) (vector->list sequence))
((string? sequence) (map char->integer (string->list sequence)))
(else (wta 'sequencep sequence 2))))))
(fset 'nth
(lambda (n list)
(if (or (null list)
(>= n (length list)))
%nil
(list-ref list n))))
(fset 'listp
(lambda (object)
(or (null object)
(list? object))))
(fset 'consp pair?)
(fset 'nconc
(lambda args
(apply append! (map (lambda (arg)
(if arg arg '()))
args))))

17
lang/elisp/primitives/load.scm
View file

@ -1,17 +0,0 @@
(define-module (lang elisp primitives load)
#:use-module (lang elisp internals load)
#:use-module (lang elisp internals evaluation)
#:use-module (lang elisp internals fset))
(fset 'load load)
(re-export load-path)
(fset 'eval
(lambda (form)
(eval form the-elisp-module)))
(fset 'autoload
(lambda args
#t))
(define-public current-load-list %nil)

68
lang/elisp/primitives/match.scm
View file

@ -1,68 +0,0 @@
(define-module (lang elisp primitives match)
#:use-module (lang elisp internals fset)
#:use-module (ice-9 regex)
#:use-module (ice-9 optargs))
(define last-match #f)
(fset 'string-match
(lambda (regexp string . start)
(define emacs-string-match
(if (defined? 'make-emacs-regexp)
;; This is what we would do if we had an
;; Emacs-compatible regexp primitive, here called
;; `make-emacs-regexp'.
(lambda (pattern str . args)
(let ((rx (make-emacs-regexp pattern))
(start (if (pair? args) (car args) 0)))
(regexp-exec rx str start)))
;; But we don't have Emacs-compatible regexps, and I
;; don't think it's worthwhile at this stage to write
;; generic regexp conversion code. So work around the
;; discrepancies between Guile/libc and Emacs regexps by
;; substituting the regexps that actually occur in the
;; elisp code that we want to read.
(lambda (pattern str . args)
(let loop ((discrepancies '(("^[0-9]+\\.\\([0-9]+\\)" .
"^[0-9]+\\.([0-9]+)"))))
(or (null? discrepancies)
(if (string=? pattern (caar discrepancies))
(set! pattern (cdar discrepancies))
(loop (cdr discrepancies)))))
(apply string-match pattern str args))))
(let ((match (apply emacs-string-match regexp string start)))
(set! last-match
(if match
(apply append!
(map (lambda (n)
(list (match:start match n)
(match:end match n)))
(iota (match:count match))))
#f)))
(if last-match (car last-match) %nil)))
(fset 'match-beginning
(lambda (subexp)
(list-ref last-match (* 2 subexp))))
(fset 'match-end
(lambda (subexp)
(list-ref last-match (+ (* 2 subexp) 1))))
(fset 'substring substring)
(fset 'match-data
(lambda* (#:optional integers reuse)
last-match))
(fset 'set-match-data
(lambda (list)
(set! last-match list)))
(fset 'store-match-data 'set-match-data)

43
lang/elisp/primitives/numbers.scm
View file

@ -1,43 +0,0 @@
(define-module (lang elisp primitives numbers)
#:use-module (lang elisp internals fset)
#:use-module (lang elisp internals null))
(fset 'logior logior)
(fset 'logand logand)
(fset 'integerp (lambda->nil integer?))
(fset '= =)
(fset '< <)
(fset '> >)
(fset '<= <=)
(fset '>= >=)
(fset '* *)
(fset '+ +)
(fset '- -)
(fset '1- 1-)
(fset 'ash ash)
(fset 'lsh
(let ()
(define (lsh num shift)
(cond ((= shift 0)
num)
((< shift 0)
;; Logical shift to the right. Do an arithmetic
;; shift and then mask out the sign bit.
(lsh (logand (ash num -1) most-positive-fixnum)
(+ shift 1)))
(else
;; Logical shift to the left. Guile's ash will
;; always preserve the sign of the result, which is
;; not what we want for lsh, so we need to work
;; around this.
(let ((new-sign-bit (ash (logand num
(logxor most-positive-fixnum
(ash most-positive-fixnum -1)))
1)))
(lsh (logxor new-sign-bit
(ash (logand num most-positive-fixnum) 1))
(- shift 1))))))
lsh))
(fset 'numberp (lambda->nil number?))

8
lang/elisp/primitives/pure.scm
View file

@ -1,8 +0,0 @@
(define-module (lang elisp primitives pure)
#:use-module (lang elisp internals fset))
;; Purification, unexec etc. are not yet implemented...
(fset 'purecopy identity)
(define-public purify-flag %nil)

10
lang/elisp/primitives/read.scm
View file

@ -1,10 +0,0 @@
(define-module (lang elisp primitives read)
#:use-module (lang elisp internals fset))
;;; MEGA HACK!!!!
(fset 'read (lambda (str)
(cond ((string=? str "?\\M-\\^@")
-134217728)
(else
(with-input-from-string str read)))))

6
lang/elisp/primitives/signal.scm
View file

@ -1,6 +0,0 @@
(define-module (lang elisp primitives signal)
#:use-module (lang elisp internals signal)
#:use-module (lang elisp internals fset))
(fset 'signal signal)
(fset 'error error)

40
lang/elisp/primitives/strings.scm
View file

@ -1,40 +0,0 @@
(define-module (lang elisp primitives strings)
#:use-module (lang elisp internals fset)
#:use-module (lang elisp internals null)
#:use-module (lang elisp internals signal))
(fset 'substring substring)
(fset 'concat
(lambda args
(apply string-append
(map (lambda (arg)
(cond
((string? arg) arg)
((list? arg) (list->string arg))
((vector? arg) (list->string (vector->list arg)))
(else (error "Wrong type argument for concat"))))
args))))
(fset 'string-to-number string->number)
(fset 'number-to-string number->string)
(fset 'string-lessp (lambda->nil string<?))
(fset 'string< 'string-lessp)
(fset 'aref
(lambda (array idx)
(cond ((vector? array) (vector-ref array idx))
((string? array) (char->integer (string-ref array idx)))
(else (wta 'arrayp array 1)))))
(fset 'aset
(lambda (array idx newelt)
(cond ((vector? array) (vector-set! array idx newelt))
((string? array) (string-set! array idx (integer->char newelt)))
(else (wta 'arrayp array 1)))))
(fset 'stringp (lambda->nil string?))
(fset 'vector vector)

40
lang/elisp/primitives/symprop.scm
View file

@ -1,40 +0,0 @@
(define-module (lang elisp primitives symprop)
#:use-module (lang elisp internals evaluation)
#:use-module (lang elisp internals fset)
#:use-module (lang elisp internals null)
#:use-module (lang elisp internals set)
#:use-module (ice-9 optargs))
;;; {Elisp Exports}
(fset 'put set-symbol-property!)
(fset 'get (lambda->nil symbol-property))
(fset 'set set)
(fset 'set-default 'set)
(fset 'boundp
(lambda (sym)
(->nil (module-defined? the-elisp-module sym))))
(fset 'default-boundp 'boundp)
(fset 'symbol-value
(lambda (sym)
(value sym #t)))
(fset 'default-value 'symbol-value)
(fset 'symbolp
(lambda (object)
(or (symbol? object)
(keyword? object)
%nil)))
(fset 'local-variable-if-set-p
(lambda* (variable #:optional buffer)
%nil))
(fset 'symbol-name symbol->string)

267
lang/elisp/primitives/syntax.scm
View file

@ -1,267 +0,0 @@
(define-module (lang elisp primitives syntax)
#:use-syntax (lang elisp expand)
#:use-module (lang elisp internals evaluation)
#:use-module (lang elisp internals fset)
#:use-module (lang elisp internals lambda)
#:use-module (lang elisp internals set)
#:use-module (lang elisp internals trace)
#:use-module (lang elisp transform))
;;; Define Emacs Lisp special forms as macros. This is more flexible
;;; than handling them specially in the translator: allows them to be
;;; redefined, and hopefully allows better source location tracking.
;;; {Variables}
(define (setq exp env)
(cons begin
(let loop ((sets (cdr exp)))
(if (null? sets)
'()
(cons `(,set (,quote ,(car sets)) ,(transformer (cadr sets)))
(loop (cddr sets)))))))
(fset 'setq
(procedure->memoizing-macro setq))
(fset 'defvar
(procedure->memoizing-macro
(lambda (exp env)
(trc 'defvar (cadr exp))
(if (null? (cddr exp))
`(,quote ,(cadr exp))
`(,begin (,if (,not (,defined? (,quote ,(cadr exp))))
,(setq (list (car exp) (cadr exp) (caddr exp)) env))
(,quote ,(cadr exp)))))))
(fset 'defconst
(procedure->memoizing-macro
(lambda (exp env)
(trc 'defconst (cadr exp))
`(,begin ,(setq (list (car exp) (cadr exp) (caddr exp)) env)
(,quote ,(cadr exp))))))
;;; {lambda, function and macro definitions}
(fset 'lambda
(procedure->memoizing-macro
(lambda (exp env)
(transform-lambda/interactive exp '<elisp-lambda>))))
(fset 'defun
(procedure->memoizing-macro
(lambda (exp env)
(trc 'defun (cadr exp))
`(,begin (,fset (,quote ,(cadr exp))
,(transform-lambda/interactive (cdr exp)
(symbol-append '<elisp-defun:
(cadr exp)
'>)))
(,quote ,(cadr exp))))))
(fset 'interactive
(procedure->memoizing-macro
(lambda (exp env)
(fluid-set! interactive-spec exp)
#f)))
(fset 'defmacro
(procedure->memoizing-macro
(lambda (exp env)
(trc 'defmacro (cadr exp))
(call-with-values (lambda () (parse-formals (caddr exp)))
(lambda (required optional rest)
(let ((num-required (length required))
(num-optional (length optional)))
`(,begin (,fset (,quote ,(cadr exp))
(,procedure->memoizing-macro
(,lambda (exp1 env1)
(,trc (,quote using) (,quote ,(cadr exp)))
(,let* ((%--args (,cdr exp1))
(%--num-args (,length %--args)))
(,cond ((,< %--num-args ,num-required)
(,error "Wrong number of args (not enough required args)"))
,@(if rest
'()
`(((,> %--num-args ,(+ num-required num-optional))
(,error "Wrong number of args (too many args)"))))
(else (,transformer
(, @bind ,(append (map (lambda (i)
(list (list-ref required i)
`(,list-ref %--args ,i)))
(iota num-required))
(map (lambda (i)
(let ((i+nr (+ i num-required)))
(list (list-ref optional i)
`(,if (,> %--num-args ,i+nr)
(,list-ref %--args ,i+nr)
,%nil))))
(iota num-optional))
(if rest
(list (list rest
`(,if (,> %--num-args
,(+ num-required
num-optional))
(,list-tail %--args
,(+ num-required
num-optional))
,%nil)))
'()))
,@(map transformer (cdddr exp)))))))))))))))))
;;; {Sequencing}
(fset 'progn
(procedure->memoizing-macro
(lambda (exp env)
`(,begin ,@(map transformer (cdr exp))))))
(fset 'prog1
(procedure->memoizing-macro
(lambda (exp env)
`(,let ((%--res1 ,(transformer (cadr exp))))
,@(map transformer (cddr exp))
%--res1))))
(fset 'prog2
(procedure->memoizing-macro
(lambda (exp env)
`(,begin ,(transformer (cadr exp))
(,let ((%--res2 ,(transformer (caddr exp))))
,@(map transformer (cdddr exp))
%--res2)))))
;;; {Conditionals}
(fset 'if
(procedure->memoizing-macro
(lambda (exp env)
(let ((else-case (cdddr exp)))
(cond ((null? else-case)
`(,nil-cond ,(transformer (cadr exp)) ,(transformer (caddr exp)) ,%nil))
((null? (cdr else-case))
`(,nil-cond ,(transformer (cadr exp))
,(transformer (caddr exp))
,(transformer (car else-case))))
(else
`(,nil-cond ,(transformer (cadr exp))
,(transformer (caddr exp))
(,begin ,@(map transformer else-case)))))))))
(fset 'and
(procedure->memoizing-macro
(lambda (exp env)
(cond ((null? (cdr exp)) #t)
((null? (cddr exp)) (transformer (cadr exp)))
(else
(cons nil-cond
(let loop ((args (cdr exp)))
(if (null? (cdr args))
(list (transformer (car args)))
(cons (list not (transformer (car args)))
(cons %nil
(loop (cdr args))))))))))))
;;; NIL-COND expressions have the form:
;;;
;;; (nil-cond COND VAL COND VAL ... ELSEVAL)
;;;
;;; The CONDs are evaluated in order until one of them returns true
;;; (in the Elisp sense, so not including empty lists). If a COND
;;; returns true, its corresponding VAL is evaluated and returned,
;;; except if that VAL is the unspecified value, in which case the
;;; result of evaluating the COND is returned. If none of the COND's
;;; returns true, ELSEVAL is evaluated and its value returned.
(define <-- *unspecified*)
(fset 'or
(procedure->memoizing-macro
(lambda (exp env)
(cond ((null? (cdr exp)) %nil)
((null? (cddr exp)) (transformer (cadr exp)))
(else
(cons nil-cond
(let loop ((args (cdr exp)))
(if (null? (cdr args))
(list (transformer (car args)))
(cons (transformer (car args))
(cons <--
(loop (cdr args))))))))))))
(fset 'cond
(procedure->memoizing-macro
(lambda (exp env)
(if (null? (cdr exp))
%nil
(cons
nil-cond
(let loop ((clauses (cdr exp)))
(if (null? clauses)
(list %nil)
(let ((clause (car clauses)))
(if (eq? (car clause) #t)
(cond ((null? (cdr clause)) (list #t))
((null? (cddr clause))
(list (transformer (cadr clause))))
(else `((,begin ,@(map transformer (cdr clause))))))
(cons (transformer (car clause))
(cons (cond ((null? (cdr clause)) <--)
((null? (cddr clause))
(transformer (cadr clause)))
(else
`(,begin ,@(map transformer (cdr clause)))))
(loop (cdr clauses)))))))))))))
(fset 'while
(procedure->memoizing-macro
(lambda (exp env)
`((,letrec ((%--while (,lambda ()
(,nil-cond ,(transformer (cadr exp))
(,begin ,@(map transformer (cddr exp))
(%--while))
,%nil))))
%--while)))))
;;; {Local binding}
(fset 'let
(procedure->memoizing-macro
(lambda (exp env)
`(, @bind ,(map (lambda (binding)
(trc 'let binding)
(if (pair? binding)
`(,(car binding) ,(transformer (cadr binding)))
`(,binding ,%nil)))
(cadr exp))
,@(map transformer (cddr exp))))))
(fset 'let*
(procedure->memoizing-macro
(lambda (exp env)
(if (null? (cadr exp))
`(,begin ,@(map transformer (cddr exp)))
(car (let loop ((bindings (cadr exp)))
(if (null? bindings)
(map transformer (cddr exp))
`((, @bind (,(let ((binding (car bindings)))
(if (pair? binding)
`(,(car binding) ,(transformer (cadr binding)))
`(,binding ,%nil))))
,@(loop (cdr bindings)))))))))))
;;; {Exception handling}
(fset 'unwind-protect
(procedure->memoizing-macro
(lambda (exp env)
(trc 'unwind-protect (cadr exp))
`(,let ((%--throw-args #f))
(,catch #t
(,lambda ()
,(transformer (cadr exp)))
(,lambda args
(,set! %--throw-args args)))
,@(map transformer (cddr exp))
(,if %--throw-args
(,apply ,throw %--throw-args))))))

14
lang/elisp/primitives/system.scm
View file

@ -1,14 +0,0 @@
(define-module (lang elisp primitives system)
#:use-module (lang elisp internals fset))
(fset 'system-name
(lambda ()
(vector-ref (uname) 1)))
(define-public system-type
(let ((uname (vector-ref (uname) 0)))
(if (string=? uname "Linux")
"gnu/linux"
uname)))
(define-public system-configuration "i386-suse-linux") ;FIXME

17
lang/elisp/primitives/time.scm
View file

@ -1,17 +0,0 @@
(define-module (lang elisp primitives time)
#:use-module (lang elisp internals time)
#:use-module (lang elisp internals fset)
#:use-module (ice-9 optargs))
(fset 'current-time
(lambda ()
(let ((now (current-time)))
(list (ash now -16)
(logand now (- (ash 1 16) 1))
0))))
(fset 'format-time-string format-time-string)
(fset 'current-time-string
(lambda* (#:optional specified-time)
(format-time-string "%a %b %e %T %Y" specified-time)))

116
lang/elisp/transform.scm
View file

@ -1,116 +0,0 @@
(define-module (lang elisp transform)
#:use-syntax (lang elisp expand)
#:use-module (lang elisp internals trace)
#:use-module (lang elisp internals fset)
#:use-module (lang elisp internals evaluation)
#:use-module (ice-9 session)
#:export (transformer transform))
;;; A note on the difference between `(transform-* (cdr x))' and `(map
;;; transform-* (cdr x))'.
;;;
;;; In most cases, none, as most of the transform-* functions are
;;; recursive.
;;;
;;; However, if (cdr x) is not a proper list, the `map' version will
;;; signal an error immediately, whereas the non-`map' version will
;;; produce a similarly improper list as its transformed output. In
;;; some cases, improper lists are allowed, so at least these cases
;;; require non-`map'.
;;;
;;; Therefore we use the non-`map' approach in most cases below, but
;;; `map' in transform-application, since in the application case we
;;; know that `(func arg . args)' is an error. It would probably be
;;; better for the transform-application case to check for an improper
;;; list explicitly and signal a more explicit error.
(define (syntax-error x)
(error "Syntax error in expression" x))
(define scheme
(procedure->memoizing-macro
(lambda (exp env)
(let ((exp (cadr exp))
(module (cddr exp)))
(let ((m (if (null? module)
the-root-module
(save-module-excursion
(lambda ()
;; In order for `resolve-module' to work as
;; expected, the current module must contain the
;; `app' variable. This is not true for #:pure
;; modules, specifically (lang elisp base). So,
;; switch to the root module (guile) before calling
;; resolve-module.
(set-current-module the-root-module)
(resolve-module (car module)))))))
(let ((x `(,eval (,quote ,exp) ,m)))
;;(write x)
;;(newline)
x))))))
(define (transformer x)
(cond ((pair? x)
(cond ((symbol? (car x))
(case (car x)
;; Allow module-related forms through intact.
((define-module use-modules use-syntax)
x)
;; Escape to Scheme.
((scheme)
(cons-source x scheme (cdr x)))
;; Quoting.
((quote function)
(cons-source x quote (transform-quote (cdr x))))
((quasiquote)
(cons-source x quasiquote (transform-quasiquote (cdr x))))
;; Anything else is a function or macro application.
(else (transform-application x))))
((and (pair? (car x))
(eq? (caar x) 'quasiquote))
(transformer (car x)))
(else (syntax-error x))))
(else
(transform-datum x))))
(define (transform-datum x)
(cond ((eq? x 'nil) %nil)
((eq? x 't) #t)
;; Could add other translations here, notably `?A' -> 65 etc.
(else x)))
(define (transform-quote x)
(trc 'transform-quote x)
(cond ((not (pair? x))
(transform-datum x))
(else
(cons-source x
(transform-quote (car x))
(transform-quote (cdr x))))))
(define (transform-quasiquote x)
(trc 'transform-quasiquote x)
(cond ((not (pair? x))
(transform-datum x))
((symbol? (car x))
(case (car x)
((unquote) (list 'unquote (transformer (cadr x))))
((unquote-splicing) (list 'unquote-splicing (transformer (cadr x))))
(else (cons-source x
(transform-datum (car x))
(transform-quasiquote (cdr x))))))
(else
(cons-source x
(transform-quasiquote (car x))
(transform-quasiquote (cdr x))))))
(define (transform-application x)
(cons-source x @fop `(,(car x) (,transformer-macro ,@(map transform-quote (cdr x))))))
(define transformer-macro
(procedure->memoizing-macro
(let ((cdr cdr))
(lambda (exp env)
(cons-source exp list (map transformer (cdr exp)))))))
(define transform transformer)

42
lang/elisp/variables.scm
View file

@ -1,42 +0,0 @@
(define-module (lang elisp variables))
;;; The only purpose of this module is to provide a place where the
;;; variables holding Elisp function definitions can be bound to
;;; symbols.
;;;
;;; This can be useful when looking at unmemoized procedure source
;;; code for Elisp functions and macros. Elisp function and macro
;;; symbols get memoized into variables. When the unmemoizer tries to
;;; unmemoize a variables, it does so by looking for a symbol that is
;;; bound to that variable, starting from the module in which the
;;; function or macro was defined and then trying the interfaces on
;;; that module's uses list. If it can't find any such symbol, it
;;; returns the symbol '???.
;;;
;;; Normally we don't want to bind Elisp function definition variables
;;; to symbols that are visible from the Elisp evaluation module (lang
;;; elisp base), because they would pollute the namespace available
;;; to Elisp variables. On the other hand, if we are trying to debug
;;; something, and looking at unmemoized source code, it's far more
;;; informative if that code has symbols that indicate the Elisp
;;; function being called than if it just says ??? everywhere.
;;;
;;; So we have a compromise, which achieves a reasonable balance of
;;; correctness (for general operation) and convenience (for
;;; debugging).
;;;
;;; 1. We bind Elisp function definition variables to symbols in this
;;; module (lang elisp variables).
;;;
;;; 2. By default, the Elisp evaluation module (lang elisp base) does
;;; not use (lang elisp variables), so the Elisp variable namespace
;;; stays clean.
;;;
;;; 3. When debugging, a simple (named-module-use! '(lang elisp base)
;;; '(lang elisp variables)) makes the function definition symbols
;;; visible in (lang elisp base) so that the unmemoizer can find
;;; them, which makes the unmemoized source code much easier to read.
;;;
;;; 4. To reduce the effects of namespace pollution even after step 3,
;;; the symbols that we bind are all prefixed with `<elisp' and
;;; suffixed with `>'.

7
test-suite/tests/elisp.test
View file

@ -1,5 +1,5 @@
;;;; elisp.test --- tests guile's elisp support -*- scheme -*-
;;;; Copyright (C) 2002, 2003, 2006 Free Software Foundation, Inc.
;;;; Copyright (C) 2002, 2003, 2006, 2009 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
@ -19,6 +19,10 @@
:use-module (test-suite lib)
:use-module (ice-9 weak-vector))
;; FIXME: the test suite is good, but it uses the old lang elisp module
;; instead of the new code. Disable for now.
'(
(define *old-stack-level* (and=> (memq 'stack (debug-options)) cadr))
(if *old-stack-level*
(debug-set! stack (* 2 *old-stack-level*)))
@ -356,4 +360,5 @@
(set! %load-should-autocompile *old-%load-should-autocompile*)
(debug-set! stack *old-stack-level*)
)
;;; elisp.test ends here