diff --git a/Makefile.am b/Makefile.am index 06c5b3870..c51a61b61 100644 --- a/Makefile.am +++ b/Makefile.am @@ -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 diff --git a/configure.ac b/configure.ac index 5ed153d57..1393d87ed 100644 --- a/configure.ac +++ b/configure.ac @@ -1614,7 +1614,6 @@ AC_CONFIG_FILES([ doc/tutorial/Makefile emacs/Makefile examples/Makefile - lang/Makefile libguile/Makefile srfi/Makefile guile-readline/Makefile diff --git a/lang/Makefile.am b/lang/Makefile.am deleted file mode 100644 index adbe4d43c..000000000 --- a/lang/Makefile.am +++ /dev/null @@ -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 diff --git a/lang/elisp/ChangeLog-2008 b/lang/elisp/ChangeLog-2008 deleted file mode 100644 index a2c3bc84b..000000000 --- a/lang/elisp/ChangeLog-2008 +++ /dev/null @@ -1,401 +0,0 @@ -2008-04-14 Neil Jerram - - * 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 - - * 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 - - * 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 - - * primitives/Makefile.am (elisp_sources): Added char-table.scm. - -2002-12-28 Neil Jerram - - * base.scm (lang): Use char-table module. - - * primitives/char-table.scm (lang): New (stub definitions). - -2002-12-08 Rob Browning - - * 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 - - * 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 - - * transform.scm (scheme): Use set-current-module to ensure - expected behaviour of resolve-module. - -2002-02-08 Neil Jerram - - * 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 - - * 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 - - * 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 - - * internals/Makefile.am (elisp_sources): Add lambda.scm. - - * internals/lambda.scm (lang): New file. - -2002-02-01 Neil Jerram - - * transform.scm (transformer), primitives/syntax.scm (let*): - Unquote uses of `begin' in transformed code. - -2002-01-29 Neil Jerram - - * 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 - - * 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 - - * 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/README b/lang/elisp/README deleted file mode 100644 index 1cecb381f..000000000 --- a/lang/elisp/README +++ /dev/null @@ -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... -: 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 - -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. diff --git a/lang/elisp/STATUS b/lang/elisp/STATUS deleted file mode 100644 index 066e86f24..000000000 --- a/lang/elisp/STATUS +++ /dev/null @@ -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. diff --git a/lang/elisp/base.scm b/lang/elisp/base.scm deleted file mode 100644 index 6c785cb8a..000000000 --- a/lang/elisp/base.scm +++ /dev/null @@ -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")) diff --git a/lang/elisp/example.el b/lang/elisp/example.el deleted file mode 100644 index eebd2f88e..000000000 --- a/lang/elisp/example.el +++ /dev/null @@ -1,39 +0,0 @@ - -(defun html-page (title &rest contents) - (concat "\n" - "\n" - "" title "\n" - "\n" - "\n" - (apply 'concat contents) - "\n" - "\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. diff --git a/lang/elisp/expand.scm b/lang/elisp/expand.scm deleted file mode 100644 index 0599d5984..000000000 --- a/lang/elisp/expand.scm +++ /dev/null @@ -1,4 +0,0 @@ -(define-module (lang elisp expand) - #:export (expand)) - -(define (expand x) x) diff --git a/lang/elisp/interface.scm b/lang/elisp/interface.scm deleted file mode 100644 index 31864cc8e..000000000 --- a/lang/elisp/interface.scm +++ /dev/null @@ -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)) diff --git a/lang/elisp/internals/evaluation.scm b/lang/elisp/internals/evaluation.scm deleted file mode 100644 index 8cbb19462..000000000 --- a/lang/elisp/internals/evaluation.scm +++ /dev/null @@ -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))) diff --git a/lang/elisp/internals/format.scm b/lang/elisp/internals/format.scm deleted file mode 100644 index 7ea562a2e..000000000 --- a/lang/elisp/internals/format.scm +++ /dev/null @@ -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)) diff --git a/lang/elisp/internals/fset.scm b/lang/elisp/internals/fset.scm deleted file mode 100644 index 249db7c91..000000000 --- a/lang/elisp/internals/fset.scm +++ /dev/null @@ -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 - ;; 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 (transform-lambda/interactive function ') - the-root-module)) - (else - (signal 'invalid-function (list function)))) - args)) diff --git a/lang/elisp/internals/lambda.scm b/lang/elisp/internals/lambda.scm deleted file mode 100644 index f7c7a4d01..000000000 --- a/lang/elisp/internals/lambda.scm +++ /dev/null @@ -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)) diff --git a/lang/elisp/internals/load.scm b/lang/elisp/internals/load.scm deleted file mode 100644 index 2b6cac36f..000000000 --- a/lang/elisp/internals/load.scm +++ /dev/null @@ -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)))) diff --git a/lang/elisp/internals/null.scm b/lang/elisp/internals/null.scm deleted file mode 100644 index 94e2b28dd..000000000 --- a/lang/elisp/internals/null.scm +++ /dev/null @@ -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)))) diff --git a/lang/elisp/internals/set.scm b/lang/elisp/internals/set.scm deleted file mode 100644 index 5e5b0048c..000000000 --- a/lang/elisp/internals/set.scm +++ /dev/null @@ -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))) diff --git a/lang/elisp/internals/signal.scm b/lang/elisp/internals/signal.scm deleted file mode 100644 index 7055a9b92..000000000 --- a/lang/elisp/internals/signal.scm +++ /dev/null @@ -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))) diff --git a/lang/elisp/internals/time.scm b/lang/elisp/internals/time.scm deleted file mode 100644 index 10ac02ddc..000000000 --- a/lang/elisp/internals/time.scm +++ /dev/null @@ -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))))) diff --git a/lang/elisp/internals/trace.scm b/lang/elisp/internals/trace.scm deleted file mode 100644 index 0dd92ec73..000000000 --- a/lang/elisp/internals/trace.scm +++ /dev/null @@ -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) diff --git a/lang/elisp/primitives/buffers.scm b/lang/elisp/primitives/buffers.scm deleted file mode 100644 index 756d4be04..000000000 --- a/lang/elisp/primitives/buffers.scm +++ /dev/null @@ -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)) - diff --git a/lang/elisp/primitives/char-table.scm b/lang/elisp/primitives/char-table.scm deleted file mode 100644 index 3812e4484..000000000 --- a/lang/elisp/primitives/char-table.scm +++ /dev/null @@ -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)) diff --git a/lang/elisp/primitives/features.scm b/lang/elisp/primitives/features.scm deleted file mode 100644 index 8cd1a9958..000000000 --- a/lang/elisp/primitives/features.scm +++ /dev/null @@ -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)))) diff --git a/lang/elisp/primitives/fns.scm b/lang/elisp/primitives/fns.scm deleted file mode 100644 index 7beb8a51c..000000000 --- a/lang/elisp/primitives/fns.scm +++ /dev/null @@ -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))) diff --git a/lang/elisp/primitives/format.scm b/lang/elisp/primitives/format.scm deleted file mode 100644 index a7c637880..000000000 --- a/lang/elisp/primitives/format.scm +++ /dev/null @@ -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) diff --git a/lang/elisp/primitives/guile.scm b/lang/elisp/primitives/guile.scm deleted file mode 100644 index 059f2bbad..000000000 --- a/lang/elisp/primitives/guile.scm +++ /dev/null @@ -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)))) diff --git a/lang/elisp/primitives/keymaps.scm b/lang/elisp/primitives/keymaps.scm deleted file mode 100644 index 730d89fbd..000000000 --- a/lang/elisp/primitives/keymaps.scm +++ /dev/null @@ -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) diff --git a/lang/elisp/primitives/lists.scm b/lang/elisp/primitives/lists.scm deleted file mode 100644 index 4907ed59d..000000000 --- a/lang/elisp/primitives/lists.scm +++ /dev/null @@ -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)))) diff --git a/lang/elisp/primitives/load.scm b/lang/elisp/primitives/load.scm deleted file mode 100644 index a627b5d10..000000000 --- a/lang/elisp/primitives/load.scm +++ /dev/null @@ -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) diff --git a/lang/elisp/primitives/match.scm b/lang/elisp/primitives/match.scm deleted file mode 100644 index 0a04ef5c5..000000000 --- a/lang/elisp/primitives/match.scm +++ /dev/null @@ -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) diff --git a/lang/elisp/primitives/numbers.scm b/lang/elisp/primitives/numbers.scm deleted file mode 100644 index 43246d32f..000000000 --- a/lang/elisp/primitives/numbers.scm +++ /dev/null @@ -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?)) diff --git a/lang/elisp/primitives/pure.scm b/lang/elisp/primitives/pure.scm deleted file mode 100644 index 7cb6b5317..000000000 --- a/lang/elisp/primitives/pure.scm +++ /dev/null @@ -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) diff --git a/lang/elisp/primitives/read.scm b/lang/elisp/primitives/read.scm deleted file mode 100644 index aeacd2c15..000000000 --- a/lang/elisp/primitives/read.scm +++ /dev/null @@ -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))))) diff --git a/lang/elisp/primitives/signal.scm b/lang/elisp/primitives/signal.scm deleted file mode 100644 index 33168c352..000000000 --- a/lang/elisp/primitives/signal.scm +++ /dev/null @@ -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) diff --git a/lang/elisp/primitives/strings.scm b/lang/elisp/primitives/strings.scm deleted file mode 100644 index 85e462f8b..000000000 --- a/lang/elisp/primitives/strings.scm +++ /dev/null @@ -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 stringinteger (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) diff --git a/lang/elisp/primitives/symprop.scm b/lang/elisp/primitives/symprop.scm deleted file mode 100644 index 8f10fd8cd..000000000 --- a/lang/elisp/primitives/symprop.scm +++ /dev/null @@ -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) diff --git a/lang/elisp/primitives/syntax.scm b/lang/elisp/primitives/syntax.scm deleted file mode 100644 index 118b3bc0c..000000000 --- a/lang/elisp/primitives/syntax.scm +++ /dev/null @@ -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 ')))) - -(fset 'defun - (procedure->memoizing-macro - (lambda (exp env) - (trc 'defun (cadr exp)) - `(,begin (,fset (,quote ,(cadr exp)) - ,(transform-lambda/interactive (cdr exp) - (symbol-append '))) - (,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)))))) diff --git a/lang/elisp/primitives/system.scm b/lang/elisp/primitives/system.scm deleted file mode 100644 index 6c659cc13..000000000 --- a/lang/elisp/primitives/system.scm +++ /dev/null @@ -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 diff --git a/lang/elisp/primitives/time.scm b/lang/elisp/primitives/time.scm deleted file mode 100644 index 4b2c70c1a..000000000 --- a/lang/elisp/primitives/time.scm +++ /dev/null @@ -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))) diff --git a/lang/elisp/transform.scm b/lang/elisp/transform.scm deleted file mode 100644 index 09159c073..000000000 --- a/lang/elisp/transform.scm +++ /dev/null @@ -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) diff --git a/lang/elisp/variables.scm b/lang/elisp/variables.scm deleted file mode 100644 index 36243739e..000000000 --- a/lang/elisp/variables.scm +++ /dev/null @@ -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 `'. diff --git a/test-suite/tests/elisp.test b/test-suite/tests/elisp.test index fd028dac6..f75b34fba 100644 --- a/test-suite/tests/elisp.test +++ b/test-suite/tests/elisp.test @@ -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