diff --git a/ChangeLog b/ChangeLog index ce4cc0e6f..4fc82d682 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,18 @@ +2002-01-13 Neil Jerram + + * Makefile.am (SUBDIRS): Added lang. + + * configure.in (AC_CONFIG_FILES): Added Makefiles in lang, + lang/elisp, lang/elisp/internals and lang/elisp/primitives. + +2002-01-11 Neil Jerram + + * acconfig.h (SCM_ENABLE_ELISP): New conditional. + + * configure.in (SCM_ENABLE_ELISP): Define this conditional (or + not) according to absence (or presence) of `--disable-elisp' + in the configure args. + 2001-12-31 Dirk Herrmann * TODO: Added two items. diff --git a/Makefile.am b/Makefile.am index 08f905225..ea26d8692 100644 --- a/Makefile.am +++ b/Makefile.am @@ -21,7 +21,7 @@ SUBDIRS = oop qt libltdl libguile ice-9 guile-config guile-readline \ - scripts srfi doc examples test-suite + scripts srfi doc examples test-suite lang bin_SCRIPTS = guile-tools diff --git a/acconfig.h b/acconfig.h index ac4b6384b..578d76399 100644 --- a/acconfig.h +++ b/acconfig.h @@ -134,6 +134,9 @@ /* Define this if you want support for arrays and uniform arrays. */ #undef HAVE_ARRAYS +/* Define this if you want Elisp support (in addition to Scheme). */ +#undef SCM_ENABLE_ELISP + /* Define this if your IPv6 has sin6_scope_id in sockaddr_in6 struct. */ #undef HAVE_SIN6_SCOPE_ID diff --git a/configure.in b/configure.in index 5a4195f57..9618a9734 100644 --- a/configure.in +++ b/configure.in @@ -129,6 +129,10 @@ dnl a required part of the distribution. AC_DEFINE(DEBUG_EXTENSIONS) AC_DEFINE(READER_EXTENSIONS) +AC_ARG_ENABLE(elisp, + [ --disable-elisp omit Emacs Lisp support],, + enable_elisp=yes) + dnl files which are destined for separate modules. if test "$enable_arrays" = yes; then @@ -150,6 +154,10 @@ if test "$enable_debug_malloc" = yes; then LIBOBJS="$LIBOBJS debug-malloc.o" fi +if test "$enable_elisp" = yes; then + AC_DEFINE(SCM_ENABLE_ELISP) +fi + #-------------------------------------------------------------------- dnl Some more checks for Win32 @@ -660,6 +668,10 @@ AC_CONFIG_FILES([ libguile/guile-snarf-docs-texi libguile/version.h ice-9/Makefile + lang/Makefile + lang/elisp/Makefile + lang/elisp/internals/Makefile + lang/elisp/primitives/Makefile oop/Makefile oop/goops/Makefile scripts/Makefile diff --git a/lang/.cvsignore b/lang/.cvsignore new file mode 100644 index 000000000..282522db0 --- /dev/null +++ b/lang/.cvsignore @@ -0,0 +1,2 @@ +Makefile +Makefile.in diff --git a/lang/Makefile.am b/lang/Makefile.am new file mode 100644 index 000000000..4538cb1ff --- /dev/null +++ b/lang/Makefile.am @@ -0,0 +1,24 @@ +## Process this file with automake to produce Makefile.in. +## +## Copyright (C) 2000 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 General Public License as +## published by the Free Software Foundation; either version 2, 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 General Public License for more details. +## +## You should have received a copy of the GNU General Public +## License along with GUILE; see the file COPYING. If not, write +## to the Free Software Foundation, Inc., 59 Temple Place, Suite +## 330, Boston, MA 02111-1307 USA + +AUTOMAKE_OPTIONS = gnu + +SUBDIRS = elisp diff --git a/lang/elisp/.cvsignore b/lang/elisp/.cvsignore new file mode 100644 index 000000000..282522db0 --- /dev/null +++ b/lang/elisp/.cvsignore @@ -0,0 +1,2 @@ +Makefile +Makefile.in diff --git a/lang/elisp/ChangeLog b/lang/elisp/ChangeLog new file mode 100644 index 000000000..8338ab0e8 --- /dev/null +++ b/lang/elisp/ChangeLog @@ -0,0 +1,194 @@ +2001-11-03 Neil Jerram + + * README (Resources): Fill in missing URLs. + +2001-11-02 Neil Jerram + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * Makefile.am (elisp_sources): Added match.scm and strings.scm. + + * match.scm, strings.scm: New files. + +2001-10-19 Neil Jerram + + * 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 + + 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. + + diff --git a/lang/elisp/Makefile.am b/lang/elisp/Makefile.am new file mode 100644 index 000000000..ffb095f1b --- /dev/null +++ b/lang/elisp/Makefile.am @@ -0,0 +1,39 @@ +## Process this file with automake to produce Makefile.in. +## +## Copyright (C) 1998, 1999, 2000, 2001 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 General Public License as +## published by the Free Software Foundation; either version 2, 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 General Public License for more details. +## +## You should have received a copy of the GNU General Public +## License along with GUILE; see the file COPYING. If not, write +## to the Free Software Foundation, Inc., 59 Temple Place, Suite +## 330, Boston, MA 02111-1307 USA + +AUTOMAKE_OPTIONS = gnu + +SUBDIRS = internals primitives + +# These should be installed and distributed. + +elisp_sources = \ + base.scm \ + example.el \ + interface.scm \ + transform.scm \ + variables.scm + +subpkgdatadir = $(pkgdatadir)/$(VERSION)/lang/elisp +subpkgdata_DATA = $(elisp_sources) +ETAGS_ARGS = $(subpkgdata_DATA) + +EXTRA_DIST = $(elisp_sources) diff --git a/lang/elisp/README b/lang/elisp/README new file mode 100644 index 000000000..f9218a0c8 --- /dev/null +++ b/lang/elisp/README @@ -0,0 +1,321 @@ + -*- 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 note that this is work in progress; the translator is +incomplete and not yet widely tested. + +** 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... +: In procedure make-char-table in expression (@fop make-char-table (# #)): +: 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 + +Lots of stuff to do with providing the special self-evaluating `nil' +and `t' symbols, and macros that convert between Scheme and Elisp +truth values, and so on. + +I'm hoping that most of this will go away, but I need to show that +it's feasible first. + +** 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 adding Elisp +support to the reader. + +- 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.) + +- `nil' and `t' should be read (I think) as #f and #t. (Done.) + +- Vector syntax is `[1 2 3]' rather than `#(1 2 3)'. (Not done.) + +Correspondingly, when printing, #f and '() should be written as +`nil'. (Not done.) + +** 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. + +* nil, #f and '() + +For Jim Blandy's notes on this, see the reference at the bottom of +this file. Currently I'm investigating a different approach, which is +better IMO than Jim's proposal because it avoids requiring multiple +false values in the Scheme world. + +According to my approach... + +- `nil' and `t' are read (when in Elisp mode) as #f and #t. + +- `(if x ...)', `(while x ...)' etc. are translated to something + like `(if (and x (not (null? x))) ...)'. + +- Functions which interpret an argument as a list -- + `cons', `setcdr', `memq', etc. -- either convert #f to '(), or + handle the #f case specially. + +- `eq' treats #f and '() as the same. + +- Optionally, functions which produce '() values -- i.e. the reader + and `cdr' -- could convert those immediately to #f. This shouldn't + affect the validity of any Elisp code, but it alters the balance of + #f and '() values swimming around in that code and so affects what + happens if two such values are returned to the Scheme world and then + compared. However, since you can never completely solve this + problem (unless you are prepared to convert arbitrarily deep + structures on entry to the Elisp world, which would kill performance), + I'm inclined not to try to solve it at all. + +* 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 + +** Mikael Djurfeldt's notes on translation + +See file guile-cvs/devel/translation/langtools.text in Guile CVS. diff --git a/lang/elisp/base.scm b/lang/elisp/base.scm new file mode 100644 index 000000000..070be333b --- /dev/null +++ b/lang/elisp/base.scm @@ -0,0 +1,38 @@ +(define-module (lang elisp base)) + +;;; {Elisp Primitives} +;;; +;;; In other words, Scheme definitions of elisp primitives. This +;;; should (ultimately) include everything that Emacs defines in C. + +(use-modules (lang elisp primitives buffers) + (lang elisp primitives features) + (lang elisp primitives format) + (lang elisp primitives fns) + (lang elisp primitives guile) + (lang elisp primitives keymaps) + (lang elisp primitives lists) + (lang elisp primitives load) + (lang elisp primitives match) + (lang elisp primitives numbers) + (lang elisp primitives pure) + (lang elisp primitives read) + (lang elisp primitives signal) + (lang elisp primitives strings) + (lang elisp primitives symprop) + (lang elisp primitives system) + (lang elisp primitives time)) + +;;; Now switch into Emacs Lisp syntax. + +(use-modules (lang elisp transform)) +(read-set! keywords 'prefix) +(read-set! language 'elisp) +(set-module-transformer! (current-module) transformer) + +;;; Everything below here is written in Elisp. + +(defun load-emacs () + (message "Calling loadup.el to clothe the bare Emacs...") + (load "loadup.el") + (message "Guile Emacs now fully clothed")) diff --git a/lang/elisp/example.el b/lang/elisp/example.el new file mode 100644 index 000000000..3379418ff --- /dev/null +++ b/lang/elisp/example.el @@ -0,0 +1,10 @@ + +(defun html-page (title &rest contents) + (concat "\n" + "\n" + "" title "\n" + "\n" + "\n" + (apply 'concat contents) + "\n" + "\n")) diff --git a/lang/elisp/interface.scm b/lang/elisp/interface.scm new file mode 100644 index 000000000..c71366acb --- /dev/null +++ b/lang/elisp/interface.scm @@ -0,0 +1,122 @@ +(define-module (lang elisp interface) + #:use-module (lang elisp internals evaluation) + #:use-module (lang elisp internals fset) + #:use-module ((lang elisp internals load) #:select ((load . elisp:load))) + #:export (eval-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}." + (eval x the-elisp-module)) + +(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-macro (use-elisp-file file-name . imports) + "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 ((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-macro (use-elisp-library library . imports) + "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 ((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 symbol)) + (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)) diff --git a/lang/elisp/internals/.cvsignore b/lang/elisp/internals/.cvsignore new file mode 100644 index 000000000..282522db0 --- /dev/null +++ b/lang/elisp/internals/.cvsignore @@ -0,0 +1,2 @@ +Makefile +Makefile.in diff --git a/lang/elisp/internals/Makefile.am b/lang/elisp/internals/Makefile.am new file mode 100644 index 000000000..49226038b --- /dev/null +++ b/lang/elisp/internals/Makefile.am @@ -0,0 +1,41 @@ +## Process this file with automake to produce Makefile.in. +## +## Copyright (C) 1998, 1999, 2000, 2001 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 General Public License as +## published by the Free Software Foundation; either version 2, 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 General Public License for more details. +## +## You should have received a copy of the GNU General Public +## License along with GUILE; see the file COPYING. If not, write +## to the Free Software Foundation, Inc., 59 Temple Place, Suite +## 330, Boston, MA 02111-1307 USA + +AUTOMAKE_OPTIONS = gnu + +# These should be installed and distributed. + +elisp_sources = \ + evaluation.scm \ + format.scm \ + fset.scm \ + load.scm \ + null.scm \ + set.scm \ + signal.scm \ + time.scm \ + trace.scm + +subpkgdatadir = $(pkgdatadir)/$(VERSION)/lang/elisp/internals +subpkgdata_DATA = $(elisp_sources) +ETAGS_ARGS = $(subpkgdata_DATA) + +EXTRA_DIST = $(elisp_sources) diff --git a/lang/elisp/internals/evaluation.scm b/lang/elisp/internals/evaluation.scm new file mode 100644 index 000000000..8cbb19462 --- /dev/null +++ b/lang/elisp/internals/evaluation.scm @@ -0,0 +1,13 @@ +(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))) diff --git a/lang/elisp/internals/format.scm b/lang/elisp/internals/format.scm new file mode 100644 index 000000000..6862dab27 --- /dev/null +++ b/lang/elisp/internals/format.scm @@ -0,0 +1,62 @@ +(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) + #:export (format + 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)) diff --git a/lang/elisp/internals/fset.scm b/lang/elisp/internals/fset.scm new file mode 100644 index 000000000..885c9e897 --- /dev/null +++ b/lang/elisp/internals/fset.scm @@ -0,0 +1,111 @@ +(define-module (lang elisp internals fset) + #:use-module (lang elisp internals signal) + #:use-module (lang elisp internals evaluation) + #: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 + ;; or . Any other + ;; procedure coming through here must be an Elisp primitive + ;; definition, so we give it a name of the form + ;; . + (or (procedure-name proc) + (set-procedure-property! proc + 'name + (symbol-append '))) + (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 ')) + (set! vsym (procedure-name (macro-transformer proc)))) + (else + ;; An alias symbol. + (set! vsym (symbol-append ')))) + ;; 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 function the-elisp-module)) + (else + (signal 'invalid-function (list function)))) + args)) diff --git a/lang/elisp/internals/load.scm b/lang/elisp/internals/load.scm new file mode 100644 index 000000000..88d14b802 --- /dev/null +++ b/lang/elisp/internals/load.scm @@ -0,0 +1,45 @@ +(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) + #:export (load-path + load)) + +(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? (string-append (car dirs) + filename)) + (string-append (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)))) diff --git a/lang/elisp/internals/null.scm b/lang/elisp/internals/null.scm new file mode 100644 index 000000000..d574e3424 --- /dev/null +++ b/lang/elisp/internals/null.scm @@ -0,0 +1,6 @@ +(define-module (lang elisp internals null) + #:export (null)) + +(define (null obj) + (or (not obj) + (null? obj))) diff --git a/lang/elisp/internals/set.scm b/lang/elisp/internals/set.scm new file mode 100644 index 000000000..cee332101 --- /dev/null +++ b/lang/elisp/internals/set.scm @@ -0,0 +1,9 @@ +(define-module (lang elisp internals set) + #:use-module (lang elisp internals evaluation) + #:use-module (lang elisp internals signal) + #:export (set)) + +;; Set SYM's variable value to VAL, and return VAL. +(define (set sym val) + (module-define! the-elisp-module sym val) + val) diff --git a/lang/elisp/internals/signal.scm b/lang/elisp/internals/signal.scm new file mode 100644 index 000000000..09e2c05a6 --- /dev/null +++ b/lang/elisp/internals/signal.scm @@ -0,0 +1,18 @@ +(define-module (lang elisp internals signal) + #:use-module (lang elisp internals format) + #:export (signal + error + 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))) diff --git a/lang/elisp/internals/time.scm b/lang/elisp/internals/time.scm new file mode 100644 index 000000000..10ac02ddc --- /dev/null +++ b/lang/elisp/internals/time.scm @@ -0,0 +1,14 @@ +(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))))) diff --git a/lang/elisp/internals/trace.scm b/lang/elisp/internals/trace.scm new file mode 100644 index 000000000..0dd92ec73 --- /dev/null +++ b/lang/elisp/internals/trace.scm @@ -0,0 +1,28 @@ +(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) diff --git a/lang/elisp/primitives/.cvsignore b/lang/elisp/primitives/.cvsignore new file mode 100644 index 000000000..282522db0 --- /dev/null +++ b/lang/elisp/primitives/.cvsignore @@ -0,0 +1,2 @@ +Makefile +Makefile.in diff --git a/lang/elisp/primitives/Makefile.am b/lang/elisp/primitives/Makefile.am new file mode 100644 index 000000000..f2bd3e919 --- /dev/null +++ b/lang/elisp/primitives/Makefile.am @@ -0,0 +1,49 @@ +## Process this file with automake to produce Makefile.in. +## +## Copyright (C) 1998, 1999, 2000, 2001 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 General Public License as +## published by the Free Software Foundation; either version 2, 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 General Public License for more details. +## +## You should have received a copy of the GNU General Public +## License along with GUILE; see the file COPYING. If not, write +## to the Free Software Foundation, Inc., 59 Temple Place, Suite +## 330, Boston, MA 02111-1307 USA + +AUTOMAKE_OPTIONS = gnu + +# These should be installed and distributed. + +elisp_sources = \ + buffers.scm \ + features.scm \ + fns.scm \ + format.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 + +subpkgdatadir = $(pkgdatadir)/$(VERSION)/lang/elisp/primitives +subpkgdata_DATA = $(elisp_sources) +ETAGS_ARGS = $(subpkgdata_DATA) + +EXTRA_DIST = $(elisp_sources) diff --git a/lang/elisp/primitives/buffers.scm b/lang/elisp/primitives/buffers.scm new file mode 100644 index 000000000..756d4be04 --- /dev/null +++ b/lang/elisp/primitives/buffers.scm @@ -0,0 +1,16 @@ +(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)) + diff --git a/lang/elisp/primitives/features.scm b/lang/elisp/primitives/features.scm new file mode 100644 index 000000000..3d1e468ed --- /dev/null +++ b/lang/elisp/primitives/features.scm @@ -0,0 +1,25 @@ +(define-module (lang elisp primitives features) + #:use-module (lang elisp internals fset) + #:use-module (lang elisp internals load) + #: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) + (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)))) diff --git a/lang/elisp/primitives/fns.scm b/lang/elisp/primitives/fns.scm new file mode 100644 index 000000000..87b05c7e0 --- /dev/null +++ b/lang/elisp/primitives/fns.scm @@ -0,0 +1,45 @@ +(define-module (lang elisp primitives fns) + #:use-module (lang elisp internals fset)) + +(fset 'fset fset) +(fset 'defalias fset) + +(fset 'apply elisp-apply) + +(fset 'funcall + (lambda (function . args) + (elisp-apply function args))) + +(fset 'interactive-p + (lambda () + #f)) + +(fset 'commandp + (lambda (sym) + (if (interactive-spec (fref sym)) #t #f))) + +(fset 'fboundp + (lambda (sym) + (variable? (symbol-fref sym)))) + +(fset 'symbol-function fref/error-if-void) + +(fset 'macroexpand macroexpand) + +(fset 'subrp + (lambda (obj) + (not (not-subr? obj)))) + +(fset 'byte-code-function-p + (lambda (object) + #f)) + +(fset 'run-hooks + (lambda (hooks) + (cond ((null hooks)) + ((list? hooks) + (for-each (lambda (hook) + (elisp-apply hook '())) + hooks)) + (else + (elisp-apply hooks '()))))) diff --git a/lang/elisp/primitives/format.scm b/lang/elisp/primitives/format.scm new file mode 100644 index 000000000..a7c637880 --- /dev/null +++ b/lang/elisp/primitives/format.scm @@ -0,0 +1,6 @@ +(define-module (lang elisp primitives format) + #:use-module (lang elisp internals format) + #:use-module (lang elisp internals fset)) + +(fset 'format format) +(fset 'message message) diff --git a/lang/elisp/primitives/guile.scm b/lang/elisp/primitives/guile.scm new file mode 100644 index 000000000..059f2bbad --- /dev/null +++ b/lang/elisp/primitives/guile.scm @@ -0,0 +1,20 @@ +(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)))) diff --git a/lang/elisp/primitives/keymaps.scm b/lang/elisp/primitives/keymaps.scm new file mode 100644 index 000000000..730d89fbd --- /dev/null +++ b/lang/elisp/primitives/keymaps.scm @@ -0,0 +1,26 @@ +(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) diff --git a/lang/elisp/primitives/lists.scm b/lang/elisp/primitives/lists.scm new file mode 100644 index 000000000..be603e2c8 --- /dev/null +++ b/lang/elisp/primitives/lists.scm @@ -0,0 +1,108 @@ +(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 + (lambda (x y) + (cons x (or y '())))) + +(fset 'null null) + +(fset 'not null) + +(fset 'car + (lambda (l) + (if (null l) + #f + (car l)))) + +(fset 'cdr + (lambda (l) + (if (null l) + #f + (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 + (lambda (cell newcdr) + (set-cdr! cell + (if (null newcdr) + '() + newcdr)))) + +(for-each (lambda (sym proc) + (fset sym + (lambda (elt list) + (if (null list) + #f + (if (null elt) + (or (proc #f list) + (proc '() list)) + (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))) + #f + (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)))) diff --git a/lang/elisp/primitives/load.scm b/lang/elisp/primitives/load.scm new file mode 100644 index 000000000..85915f1f7 --- /dev/null +++ b/lang/elisp/primitives/load.scm @@ -0,0 +1,17 @@ +(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 #f) diff --git a/lang/elisp/primitives/match.scm b/lang/elisp/primitives/match.scm new file mode 100644 index 000000000..9b232c1ae --- /dev/null +++ b/lang/elisp/primitives/match.scm @@ -0,0 +1,68 @@ +(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) #f))) + +(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) diff --git a/lang/elisp/primitives/numbers.scm b/lang/elisp/primitives/numbers.scm new file mode 100644 index 000000000..dd72551dd --- /dev/null +++ b/lang/elisp/primitives/numbers.scm @@ -0,0 +1,42 @@ +(define-module (lang elisp primitives numbers) + #:use-module (lang elisp internals fset)) + +(fset 'logior logior) +(fset 'logand logand) +(fset 'integerp 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 number?) diff --git a/lang/elisp/primitives/pure.scm b/lang/elisp/primitives/pure.scm new file mode 100644 index 000000000..217550c53 --- /dev/null +++ b/lang/elisp/primitives/pure.scm @@ -0,0 +1,8 @@ +(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 #f) diff --git a/lang/elisp/primitives/read.scm b/lang/elisp/primitives/read.scm new file mode 100644 index 000000000..aeacd2c15 --- /dev/null +++ b/lang/elisp/primitives/read.scm @@ -0,0 +1,10 @@ +(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))))) diff --git a/lang/elisp/primitives/signal.scm b/lang/elisp/primitives/signal.scm new file mode 100644 index 000000000..33168c352 --- /dev/null +++ b/lang/elisp/primitives/signal.scm @@ -0,0 +1,6 @@ +(define-module (lang elisp primitives signal) + #:use-module (lang elisp internals signal) + #:use-module (lang elisp internals fset)) + +(fset 'signal signal) +(fset 'error error) diff --git a/lang/elisp/primitives/strings.scm b/lang/elisp/primitives/strings.scm new file mode 100644 index 000000000..4326aeb93 --- /dev/null +++ b/lang/elisp/primitives/strings.scm @@ -0,0 +1,31 @@ +(define-module (lang elisp primitives strings) + #:use-module (lang elisp internals fset) + #: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 stringinteger (string-ref array idx))) + (else (wta 'arrayp array 1))))) + +(fset 'stringp string?) diff --git a/lang/elisp/primitives/symprop.scm b/lang/elisp/primitives/symprop.scm new file mode 100644 index 000000000..ffdc7e6ae --- /dev/null +++ b/lang/elisp/primitives/symprop.scm @@ -0,0 +1,40 @@ +(define-module (lang elisp primitives symprop) + #:use-module (lang elisp internals set) + #:use-module (lang elisp internals fset) + #:use-module (lang elisp internals evaluation) + #:use-module (ice-9 optargs)) + +;;; {Elisp Exports} + +(fset 'put set-symbol-property!) + +(fset 'get symbol-property) + +(fset 'set set) + +(fset 'set-default 'set) + +(fset 'boundp + (lambda (sym) + (module-defined? the-elisp-module sym))) + +(fset 'default-boundp 'boundp) + +(fset 'symbol-value + (lambda (sym) + (if (module-defined? the-elisp-module sym) + (module-ref the-elisp-module sym) + (error "Symbol's value as variable is void:" sym)))) + +(fset 'default-value 'symbol-value) + +(fset 'symbolp + (lambda (object) + (or (symbol? object) + (keyword? object)))) + +(fset 'local-variable-if-set-p + (lambda* (variable #:optional buffer) + #f)) + +(fset 'symbol-name symbol->string) diff --git a/lang/elisp/primitives/system.scm b/lang/elisp/primitives/system.scm new file mode 100644 index 000000000..6c659cc13 --- /dev/null +++ b/lang/elisp/primitives/system.scm @@ -0,0 +1,14 @@ +(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 diff --git a/lang/elisp/primitives/time.scm b/lang/elisp/primitives/time.scm new file mode 100644 index 000000000..4b2c70c1a --- /dev/null +++ b/lang/elisp/primitives/time.scm @@ -0,0 +1,17 @@ +(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))) diff --git a/lang/elisp/transform.scm b/lang/elisp/transform.scm new file mode 100644 index 000000000..2f6ed8db5 --- /dev/null +++ b/lang/elisp/transform.scm @@ -0,0 +1,414 @@ +(define-module (lang elisp transform) + #: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)) + +(define interactive-spec (make-fluid)) + +;;; {S-expressions} +;;; + +(define (syntax-error x) + (error "Syntax error in expression" x)) + +;; Should be made mutating instead of constructing +;; +(define (transformer x) + (cond ((null? x) '()) + ((not (pair? x)) x) + ((and (pair? (car x)) + (eq? (caar x) 'quasiquote)) + (transformer (car x))) + ((symbol? (car x)) + (case (car x) + ((@fop @bind define-module use-modules use-syntax) x) + ; Escape to Scheme syntax + ((scheme) (cons 'begin (cdr x))) + ; Should be handled in reader + ((quote function) (cons 'quote (cars->nil (cdr x)))) + ((quasiquote) (m-quasiquote x '())) + ((nil-cond) (transform-1 x)) + ((let) (m-let x '())) + ((let*) (m-let* x '())) + ((if) (m-if x '())) + ((and) (m-and x '())) + ((or) (m-or x '())) + ((while) (m-while x '())) + ;((while) (cons macro-while (cdr x))) + ((prog1) (m-prog1 x '())) + ((prog2) (m-prog2 x '())) + ((progn begin) (cons 'begin (map transformer (cdr x)))) + ((cond) (m-cond x '())) + ((lambda) (transform-lambda/interactive x ')) + ((defun) (m-defun x '())) + ((defmacro) (m-defmacro x '())) + ((setq) (m-setq x '())) + ((defvar) (m-defvar x '())) + ((defconst) (m-defconst x '())) + ((interactive) (fluid-set! interactive-spec x) #f) + ((unwind-protect) (m-unwind-protect x '())) + (else (transform-application x)))) + (else (syntax-error x)))) + +(define (m-unwind-protect exp env) + (trc 'unwind-protect (cadr exp)) + `(let ((%--throw-args #f)) + (catch #t + (lambda () + ,(transformer (cadr exp))) + (lambda args + (set! %--throw-args args))) + ,@(transform-list (cddr exp)) + (if %--throw-args + (apply throw %--throw-args)))) + +(define (m-quasiquote exp env) + (cons 'quasiquote + (map transform-inside-qq (cdr exp)))) + +(define (transform-inside-qq x) + (trc 'transform-inside-qq x) + (cond ((not (pair? x)) x) + ((symbol? (car x)) + (case (car x) + ((unquote) (list 'unquote (transformer (cadr x)))) + ((unquote-splicing) (list 'unquote-splicing (transformer (cadr x)))) + (else (cons (car x) (map transform-inside-qq (cdr x)))))) + (else + (cons (transform-inside-qq (car x)) (transform-inside-qq (cdr x)))))) + +(define (transform-1 x) + (cons (car x) (map transformer (cdr x)))) + +(define (transform-2 x) + (cons (car x) + (cons (cadr x) + (map transformer (cddr x))))) + +(define (transform-3 x) + (cons (car x) + (cons (cadr x) + (cons (caddr x) + (map transformer (cdddr x)))))) + +(define (transform-list x) + (map transformer x)) + +;;; 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/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 'name ',name) + (set! (,not-subr? %--lambda) #t) + ,@(if is + `((set! (,interactive-specification %--lambda) ',is)) + '()) + %--lambda))) + +(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) + #f)))) + (iota num-optional)) + (if rest + (list (list rest + `(if (> %--num-args + ,(+ num-required + num-optional)) + (list-tail %--args + ,(+ num-required + num-optional)) + '()))) + '())) + ,@(transform-list (cddr exp))))))) + )))) + +(define (m-defun exp env) + (trc 'defun (cadr exp)) + `(begin (,fset ',(cadr exp) + ,(transform-lambda/interactive (cdr exp) + (symbol-append '))) + ',(cadr exp))) + +(define (m-defmacro 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 ',(cadr exp) + (procedure->memoizing-macro + (lambda (exp1 env1) + (,trc 'using ',(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) + #f)))) + (iota num-optional)) + (if rest + (list (list rest + `(if (> %--num-args + ,(+ num-required + num-optional)) + (list-tail %--args + ,(+ num-required + num-optional)) + '()))) + '())) + ,@(transform-list (cdddr exp))))))))))))))) + +(define (transform-application x) + `(@fop ,(car x) + (,transformer-macro ,@(cdr x)))) + +(define transformer-macro + (procedure->memoizing-macro + (lambda (exp env) + (cons 'list (map transformer (cdr exp)))))) + +; (cons '@fop +; (cons (car x) +; (map transformer (cdr x))))) + +(define (cars->nil ls) + (cond ((not (pair? ls)) ls) + ((null? (car ls)) (cons '() (cars->nil (cdr ls)))) + (else (cons (cars->nil (car ls)) + (cars->nil (cdr ls)))))) + +;;; {Special forms} +;;; + +(define (m-setq exp env) + (cons 'begin + (let loop ((sets (cdr exp)) (last-sym #f)) + (if (null? sets) + (list last-sym) + (cons `(module-define! ,the-elisp-module + ',(car sets) + ,(transformer (cadr sets))) + (loop (cddr sets) (car sets))))))) + +;(define (m-setq exp env) +; (let* ((binder (car (last-pair env))) +; (varvals (let loop ((ls (cdr exp))) +; (if (null? ls) +; '() +; ;; Ensure existence only at macro expansion time +; (let ((var (or (binder (car ls) #f) +; (binder (car ls) #t)))) +; (if (not (variable-bound? var)) +; (variable-set! var #f)) +; (cons (list 'set! (car ls) (transformer (cadr ls))) +; (loop (cddr ls)))))))) +; (cond ((null? varvals) '()) +; ((null? (cdr varvals)) (car varvals)) +; (else (cons 'begin varvals))))) + +(define (m-let exp env) + `(@bind ,(map (lambda (binding) + (trc 'let binding) + (if (pair? binding) + `(,(car binding) ,(transformer (cadr binding))) + `(,binding #f))) + (cadr exp)) + ,@(transform-list (cddr exp)))) + +(define (m-let* exp env) + (if (null? (cadr exp)) + `(begin ,@(transform-list (cddr exp))) + (car (let loop ((bindings (cadr exp))) + (if (null? bindings) + (transform-list (cddr exp)) + `((@bind (,(let ((binding (car bindings))) + (if (pair? binding) + `(,(car binding) ,(transformer (cadr binding))) + `(,binding #f)))) + ,@(loop (cdr bindings))))))))) + +(define (m-prog1 exp env) + `(,let ((%res1 ,(transformer (cadr exp)))) + ,@(transform-list (cddr exp)) + %res1)) + +(define (m-prog2 exp env) + `(begin ,(transformer (cadr exp)) + (,let ((%res2 ,(transformer (caddr exp)))) + ,@(transform-list (cdddr exp)) + %res2))) + +(define <-- *unspecified*) + +(define (m-if exp env) + (let ((else-case (cdddr exp))) + (cond ((null? else-case) + `(nil-cond ,(transformer (cadr exp)) ,(transformer (caddr exp)) #f)) + ((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 ,@(transform-list else-case))))))) + +(define (m-and 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 #f + (loop (cdr args)))))))))) + +(define (m-or exp env) + (cond ((null? (cdr exp)) #f) + ((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)))))))))) + +(define m-cond + (lambda (exp env) + (if (null? (cdr exp)) + #f + (cons + 'nil-cond + (let loop ((clauses (cdr exp))) + (if (null? clauses) + '(#f) + (let ((clause (car clauses))) + (if (eq? (car clause) #t) + (cond ((null? (cdr clause)) '(t)) + ((null? (cddr clause)) + (list (transformer (cadr clause)))) + (else `((begin ,@(transform-list (cdr clause)))))) + (cons (transformer (car clause)) + (cons (cond ((null? (cdr clause)) <--) + ((null? (cddr clause)) + (transformer (cadr clause))) + (else + `(begin ,@(transform-list (cdr clause))))) + (loop (cdr clauses)))))))))))) + +(define (m-while exp env) + `(,let %while () + (nil-cond ,(transformer (cadr exp)) + (begin ,@(transform-list (cddr exp)) (%while)) + #f))) + +(define (m-defvar exp env) + (trc 'defvar (cadr exp)) + (if (null? (cddr exp)) + `',(cadr exp) + `(begin (if (not (defined? ',(cadr exp))) + (,macro-setq ,(cadr exp) ,(caddr exp))) + ',(cadr exp)))) + +(define (m-defconst exp env) + (trc 'defconst (cadr exp)) + `(begin ,(m-setq (list (car exp) (cadr exp) (caddr exp)) env) + ',(cadr exp))) + +;(export-mmacros +; '(setq defun let let* if and or cond while prog1 prog2 progn) +; (list m-setq m-defun m-let m-let* m-if m-and m-or m-cond m-while m-prog1 m-prog2 begin)) + +(define macro-setq (procedure->memoizing-macro m-setq)) +(define macro-while (procedure->memoizing-macro m-while)) diff --git a/lang/elisp/variables.scm b/lang/elisp/variables.scm new file mode 100644 index 000000000..36243739e --- /dev/null +++ b/lang/elisp/variables.scm @@ -0,0 +1,42 @@ +(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 `'. diff --git a/test-suite/Makefile.am b/test-suite/Makefile.am index 5db5ba0d2..09e8d8a3b 100644 --- a/test-suite/Makefile.am +++ b/test-suite/Makefile.am @@ -5,6 +5,7 @@ SCM_TESTS = tests/alist.test \ tests/c-api.test \ tests/chars.test \ tests/common-list.test \ + tests/elisp.test \ tests/environments.test \ tests/eval.test \ tests/exceptions.test \