diff options
author | Neil Jerram <neil@ossau.uklinux.net> | 2002-02-08 11:50:51 +0000 |
---|---|---|
committer | Neil Jerram <neil@ossau.uklinux.net> | 2002-02-08 11:50:51 +0000 |
commit | e79236a948466c0bc62aaa6c1d6118ee34373669 (patch) | |
tree | 7c208a2282313542b208033b237a76c4e8917bc6 | |
parent | 1f761e0a5941b4743199d57e885026cc02badf35 (diff) | |
download | guile-e79236a948466c0bc62aaa6c1d6118ee34373669.tar.gz |
* Complete Elisp translator work.
-rw-r--r-- | lang/elisp/ChangeLog | 82 | ||||
-rw-r--r-- | lang/elisp/README | 72 | ||||
-rw-r--r-- | lang/elisp/STATUS | 35 | ||||
-rw-r--r-- | lang/elisp/base.scm | 16 | ||||
-rw-r--r-- | lang/elisp/example.el | 29 | ||||
-rw-r--r-- | lang/elisp/interface.scm | 8 | ||||
-rw-r--r-- | lang/elisp/internals/lambda.scm | 46 | ||||
-rw-r--r-- | lang/elisp/internals/null.scm | 14 | ||||
-rw-r--r-- | lang/elisp/primitives/features.scm | 3 | ||||
-rw-r--r-- | lang/elisp/primitives/fns.scm | 6 | ||||
-rw-r--r-- | lang/elisp/primitives/lists.scm | 29 | ||||
-rw-r--r-- | lang/elisp/primitives/load.scm | 2 | ||||
-rw-r--r-- | lang/elisp/primitives/match.scm | 2 | ||||
-rw-r--r-- | lang/elisp/primitives/numbers.scm | 7 | ||||
-rw-r--r-- | lang/elisp/primitives/pure.scm | 2 | ||||
-rw-r--r-- | lang/elisp/primitives/strings.scm | 5 | ||||
-rw-r--r-- | lang/elisp/primitives/symprop.scm | 12 | ||||
-rw-r--r-- | lang/elisp/primitives/syntax.scm | 118 | ||||
-rw-r--r-- | lang/elisp/transform.scm | 125 |
19 files changed, 385 insertions, 228 deletions
diff --git a/lang/elisp/ChangeLog b/lang/elisp/ChangeLog index d20d6e355..c30491159 100644 --- a/lang/elisp/ChangeLog +++ b/lang/elisp/ChangeLog @@ -1,3 +1,85 @@ +2002-02-08 Neil Jerram <neil@ossau.uklinux.net> + + * STATUS: New file. + + * README: Updated. + + * interface.scm (translate-elisp): New exported procedure. + (elisp-function): Symbol var is `obj', not `symbol'. + + * internals/lambda.scm, primitives/fns.scm: Fix confusion between + interactive-spec and interactive-specification. + + * internals/lambda.scm (transform-lambda), primitives/syntax.scm + (defmacro): Bind unspecified optional and rest arguments to #nil, + not #f. + + * internals/null.scm (->nil, lambda->nil): New, exported. + (null): Use ->nil. + + * primitives/features.scm (featurep), primitives/fns.scm + (fboundp, subrp): Use ->nil. + + * internals/lists.scm (cons, setcdr, memq, member, assq, assoc): + Simplified. + (car, cdr): Return #nil rather than #f. + + * primitives/load.scm (current-load-list), primitives/pure.scm + (purify-flag): Set to #nil, not #f. + + * primitives/match.scm (string-match): Return #nil rather than #f. + + * primitives/numbers.scm (integerp, numberp), + primitives/strings.scm (string-lessp, stringp): Use lambda->nil. + + * primitives/symprop.scm (boundp): Use ->nil. + (symbolp, local-variable-if-set-p): Return #nil rather than #f. + + * primitives/syntax.scm (prog1, prog2): Mangle variable names + further to lessen possibility of conflicts. + (if, and, or, cond): Return #nil rather than #f. + (cond): Return #t rather than t (which is undefined). + (let, let*): Bind uninitialized variables to #nil, not #f. + + * transform.scm: Resolve inconsistency in usage of `map', and add + an explanatory note. Also cleaned up use of subsidiary + transformation functions. Also use cons-source wherever possible. + (transform-datum, transform-quote): New. + (transform-quasiquote): Renamed from `transform-inside-qq'. + (transform-application): Apply `transform-quote' to application + args. + (cars->nil): Removed. + + * internals/null.scm (null), primitives/lists.scm (cons, car, cdr, + setcdr, memq, member, assq, assoc, nth): Update to take into + account new libguile support for Elisp nil value. + +2002-02-06 Neil Jerram <neil@ossau.uklinux.net> + + * example.el (time): New macro, for performance measurement. + Accompanying comment compares results for Guile and Emacs. + + * transform.scm (scheme): New macro. + (transformer): New implementation of `scheme' escape that doesn't + rely on (lang elisp base) importing Guile bindings. + + * base.scm: No longer import anything from (guile). + (load-emacs): Add scheme form to ensure that keywords + read option is set correctly. + + * primitives/syntax.scm (defmacro, let, let*): Unquote uses of + `@bind' in transformed code. + (if): Unquote uses of `nil-cond' in transformed code. + + * internals/lambda.scm (transform-lambda): Unquote use of `@bind' + in transformed code. + + * transform.scm (transformer-macro): Don't quote `list' in + transformed code. + (transform-application): Don't quote `@fop' in transformed code. + (transformer): No need to treat `@bind' and `@fop' as special + cases in input to the transformer. + 2002-02-04 Neil Jerram <neil@ossau.uklinux.net> * primitives/syntax.scm (parse-formals, transform-lambda, diff --git a/lang/elisp/README b/lang/elisp/README index f9218a0c8..1cecb381f 100644 --- a/lang/elisp/README +++ b/lang/elisp/README @@ -45,8 +45,7 @@ and try to bootstrap a complete Emacs environment: * Status -Please note that this is work in progress; the translator is -incomplete and not yet widely tested. +Please see the STATUS file for the full position. ** Trying to load a complete Emacs environment. @@ -163,12 +162,23 @@ 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. +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. -I'm hoping that most of this will go away, but I need to show that -it's feasible first. +- 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 @@ -191,8 +201,9 @@ that Ken Raeburn has been doing on the Emacs codebase. 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. +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 @@ -204,12 +215,10 @@ support to the reader. 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)'. -- 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.) +- When in an Elisp environment, #nil and #t should print as `nil' and + `t'. ** The Elisp evaluation module (lang elisp base) @@ -272,36 +281,6 @@ 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 @@ -316,6 +295,9 @@ http://gemacs.sourceforge.net 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-cvs/devel/translation/langtools.text in Guile CVS. +See file guile-core/devel/translation/langtools.text in Guile CVS. diff --git a/lang/elisp/STATUS b/lang/elisp/STATUS new file mode 100644 index 000000000..066e86f24 --- /dev/null +++ b/lang/elisp/STATUS @@ -0,0 +1,35 @@ + -*-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 index c4d2b8d9a..31bd759f7 100644 --- a/lang/elisp/base.scm +++ b/lang/elisp/base.scm @@ -1,13 +1,12 @@ (define-module (lang elisp base) - ;; Be pure. Nothing in this module requires most of the standard - ;; Guile builtins, and it creates a problem if this module has - ;; access to them, as @bind can dynamically change their values. + ;; 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 - ;; But we do need a few builtins - import them here. - #:use-module ((guile) #:select (@fop @bind nil-cond)) - ;; {Elisp Primitives} ;; ;; In other words, Scheme definitions of elisp primitives. This @@ -34,13 +33,10 @@ ;; Now switch into Emacs Lisp syntax. #:use-syntax (lang elisp transform)) -;(use-modules (lang elisp transform)) -;(read-set! keywords 'prefix) -;(set-module-transformer! (current-module) transformer) - ;;; Everything below here is written in Elisp. (defun load-emacs () + (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 index 3379418ff..eebd2f88e 100644 --- a/lang/elisp/example.el +++ b/lang/elisp/example.el @@ -8,3 +8,32 @@ (apply 'concat contents) "</BODY>\n" "</HTML>\n")) + +(defmacro time (repeat-count &rest body) + `(let ((count ,repeat-count) + (beg (current-time)) + end) + (while (> count 0) + (setq count (- count 1)) + ,@body) + (setq end (current-time)) + (+ (* 1000000.0 (+ (* 65536.0 (- (car end) (car beg))) + (- (cadr end) (cadr beg)))) + (* 1.0 (- (caddr end) (caddr beg)))))) + +;Non-scientific performance measurements (Guile measurements are with +;`guile -q --no-debug'): +; +;(time 100000 (+ 3 4)) +; => 225,071 (Emacs) 4,000,000 (Guile) +;(time 100000 (lambda () 1)) +; => 2,410,456 (Emacs) 4,000,000 (Guile) +;(time 100000 (apply 'concat (mapcar (lambda (s) (concat s "." s)) '("a" "b" "c" "d")))) +; => 10,185,792 (Emacs) 136,000,000 (Guile) +;(defun sc (s) (concat s "." s)) +;(time 100000 (apply 'concat (mapcar 'sc '("a" "b" "c" "d")))) +; => 7,870,055 (Emacs) 26,700,000 (Guile) +; +;Sadly, it looks like the translator's performance sucks quite badly +;when compared with Emacs. But the translator is still very new, so +;there's probably plenty of room of improvement. diff --git a/lang/elisp/interface.scm b/lang/elisp/interface.scm index c71366acb..1e0758569 100644 --- a/lang/elisp/interface.scm +++ b/lang/elisp/interface.scm @@ -2,7 +2,9 @@ #: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 @@ -19,6 +21,10 @@ "Evaluate the Elisp expression @var{x}." (eval x the-elisp-module)) +(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}." @@ -112,7 +118,7 @@ exported to Elisp." (error "No macro name specified or deducible:" obj))) ((symbol? obj) (or name - (set! name symbol)) + (set! name obj)) (module-add! the-elisp-module name (module-ref (current-module) obj))) (else diff --git a/lang/elisp/internals/lambda.scm b/lang/elisp/internals/lambda.scm index 96b21f650..9917c08bd 100644 --- a/lang/elisp/internals/lambda.scm +++ b/lang/elisp/internals/lambda.scm @@ -67,28 +67,28 @@ `(((,> %--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)) - '()))) - '())) - ,@(map transformer (cddr exp))))))))))) + (, @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)) @@ -101,7 +101,7 @@ (,set-procedure-property! %--lambda (,quote name) (,quote ,name)) (,set-not-subr! %--lambda #t) ,@(if is - `((,set! (,interactive-spec %--lambda) (,quote ,is))) + `((,set! (,interactive-specification %--lambda) (,quote ,is))) '()) %--lambda))) diff --git a/lang/elisp/internals/null.scm b/lang/elisp/internals/null.scm index 420278e0c..94e2b28dd 100644 --- a/lang/elisp/internals/null.scm +++ b/lang/elisp/internals/null.scm @@ -1,7 +1,13 @@ (define-module (lang elisp internals null) - #:export (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) - (or (not obj) - (null? obj) - (eq? obj 'nil))) ; Should be removed. + (->nil (or (not obj) + (null? obj)))) diff --git a/lang/elisp/primitives/features.scm b/lang/elisp/primitives/features.scm index 3d1e468ed..8cd1a9958 100644 --- a/lang/elisp/primitives/features.scm +++ b/lang/elisp/primitives/features.scm @@ -1,6 +1,7 @@ (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 '()) @@ -12,7 +13,7 @@ (fset 'featurep (lambda (feature) - (memq feature features))) + (->nil (memq feature features)))) (fset 'require (lambda* (feature #:optional file-name noerror) diff --git a/lang/elisp/primitives/fns.scm b/lang/elisp/primitives/fns.scm index ba2b53a79..f7a4aa003 100644 --- a/lang/elisp/primitives/fns.scm +++ b/lang/elisp/primitives/fns.scm @@ -18,11 +18,11 @@ (fset 'commandp (lambda (sym) - (if (interactive-spec (fref sym)) #t %nil))) + (if (interactive-specification (fref sym)) #t %nil))) (fset 'fboundp (lambda (sym) - (variable? (symbol-fref sym)))) + (->nil (variable? (symbol-fref sym))))) (fset 'symbol-function fref/error-if-void) @@ -30,7 +30,7 @@ (fset 'subrp (lambda (obj) - (not (not-subr? obj)))) + (->nil (not (not-subr? obj))))) (fset 'byte-code-function-p (lambda (object) diff --git a/lang/elisp/primitives/lists.scm b/lang/elisp/primitives/lists.scm index 43843f811..4907ed59d 100644 --- a/lang/elisp/primitives/lists.scm +++ b/lang/elisp/primitives/lists.scm @@ -3,9 +3,7 @@ #:use-module (lang elisp internals null) #:use-module (lang elisp internals signal)) -(fset 'cons - (lambda (x y) - (cons x (or y '())))) +(fset 'cons cons) (fset 'null null) @@ -14,13 +12,13 @@ (fset 'car (lambda (l) (if (null l) - #f + %nil (car l)))) (fset 'cdr (lambda (l) (if (null l) - #f + %nil (cdr l)))) (fset 'eq @@ -35,12 +33,7 @@ (fset 'setcar set-car!) -(fset 'setcdr - (lambda (cell newcdr) - (set-cdr! cell - (if (null newcdr) - '() - newcdr)))) +(fset 'setcdr set-cdr!) (for-each (lambda (sym proc) (fset sym @@ -48,14 +41,10 @@ (if (null list) %nil (if (null elt) - (or (proc #f list) - (proc '() list) - (proc %nil list) - (proc 'nil list)) ; 'nil shouldn't be - ; here, as it should - ; have been - ; translated by the - ; transformer. + (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)) @@ -97,7 +86,7 @@ (lambda (n list) (if (or (null list) (>= n (length list))) - #f + %nil (list-ref list n)))) (fset 'listp diff --git a/lang/elisp/primitives/load.scm b/lang/elisp/primitives/load.scm index 85915f1f7..a627b5d10 100644 --- a/lang/elisp/primitives/load.scm +++ b/lang/elisp/primitives/load.scm @@ -14,4 +14,4 @@ (lambda args #t)) -(define-public current-load-list #f) +(define-public current-load-list %nil) diff --git a/lang/elisp/primitives/match.scm b/lang/elisp/primitives/match.scm index 9b232c1ae..0a04ef5c5 100644 --- a/lang/elisp/primitives/match.scm +++ b/lang/elisp/primitives/match.scm @@ -45,7 +45,7 @@ (iota (match:count match)))) #f))) - (if last-match (car last-match) #f))) + (if last-match (car last-match) %nil))) (fset 'match-beginning (lambda (subexp) diff --git a/lang/elisp/primitives/numbers.scm b/lang/elisp/primitives/numbers.scm index dd72551dd..43246d32f 100644 --- a/lang/elisp/primitives/numbers.scm +++ b/lang/elisp/primitives/numbers.scm @@ -1,9 +1,10 @@ (define-module (lang elisp primitives numbers) - #:use-module (lang elisp internals fset)) + #:use-module (lang elisp internals fset) + #:use-module (lang elisp internals null)) (fset 'logior logior) (fset 'logand logand) -(fset 'integerp integer?) +(fset 'integerp (lambda->nil integer?)) (fset '= =) (fset '< <) (fset '> >) @@ -39,4 +40,4 @@ (- shift 1)))))) lsh)) -(fset 'numberp number?) +(fset 'numberp (lambda->nil number?)) diff --git a/lang/elisp/primitives/pure.scm b/lang/elisp/primitives/pure.scm index 217550c53..7cb6b5317 100644 --- a/lang/elisp/primitives/pure.scm +++ b/lang/elisp/primitives/pure.scm @@ -5,4 +5,4 @@ (fset 'purecopy identity) -(define-public purify-flag #f) +(define-public purify-flag %nil) diff --git a/lang/elisp/primitives/strings.scm b/lang/elisp/primitives/strings.scm index 08bd8f8de..85a1c10a9 100644 --- a/lang/elisp/primitives/strings.scm +++ b/lang/elisp/primitives/strings.scm @@ -1,5 +1,6 @@ (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) @@ -19,7 +20,7 @@ (fset 'number-to-string number->string) -(fset 'string-lessp string<?) +(fset 'string-lessp (lambda->nil string<?)) (fset 'string< 'string-lessp) (fset 'aref @@ -28,6 +29,6 @@ ((string? array) (char->integer (string-ref array idx))) (else (wta 'arrayp array 1))))) -(fset 'stringp string?) +(fset 'stringp (lambda->nil string?)) (fset 'vector vector) diff --git a/lang/elisp/primitives/symprop.scm b/lang/elisp/primitives/symprop.scm index 4ca169226..a520a4b81 100644 --- a/lang/elisp/primitives/symprop.scm +++ b/lang/elisp/primitives/symprop.scm @@ -1,7 +1,8 @@ (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 (lang elisp internals fset) + #:use-module (lang elisp internals null) + #:use-module (lang elisp internals set) #:use-module (ice-9 optargs)) ;;; {Elisp Exports} @@ -16,7 +17,7 @@ (fset 'boundp (lambda (sym) - (module-defined? the-elisp-module sym))) + (->nil (module-defined? the-elisp-module sym)))) (fset 'default-boundp 'boundp) @@ -29,10 +30,11 @@ (fset 'symbolp (lambda (object) (or (symbol? object) - (keyword? object)))) + (keyword? object) + %nil))) (fset 'local-variable-if-set-p (lambda* (variable #:optional buffer) - #f)) + %nil)) (fset 'symbol-name symbol->string) diff --git a/lang/elisp/primitives/syntax.scm b/lang/elisp/primitives/syntax.scm index 7f7e4af21..a597cd06a 100644 --- a/lang/elisp/primitives/syntax.scm +++ b/lang/elisp/primitives/syntax.scm @@ -32,7 +32,6 @@ `(,quote ,(cadr exp)) `(,begin (,if (,not (,defined? (,quote ,(cadr exp)))) ,(setq (list (car exp) (cadr exp) (caddr exp)) env)) - ;; (,macro-setq ,(cadr exp) ,(caddr exp))) (,quote ,(cadr exp))))))) (fset 'defconst @@ -87,28 +86,28 @@ `(((,> %--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)) - '()))) - '())) - ,@(map transformer (cdddr exp))))))))))))))))) + (, @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} @@ -120,36 +119,34 @@ (fset 'prog1 (procedure->memoizing-macro (lambda (exp env) - `(,let ((%res1 ,(transformer (cadr exp)))) + `(,let ((%--res1 ,(transformer (cadr exp)))) ,@(map transformer (cddr exp)) - %res1)))) + %--res1)))) (fset 'prog2 (procedure->memoizing-macro (lambda (exp env) `(,begin ,(transformer (cadr exp)) - (,let ((%res2 ,(transformer (caddr exp)))) + (,let ((%--res2 ,(transformer (caddr exp)))) ,@(map transformer (cdddr exp)) - %res2))))) + %--res2))))) ;;; {Conditionals} -(define <-- *unspecified*) - (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)) #f)) + `(,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)))) + `(,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))))))))) + `(,nil-cond ,(transformer (cadr exp)) + ,(transformer (caddr exp)) + (,begin ,@(map transformer else-case))))))))) (fset 'and (procedure->memoizing-macro @@ -162,13 +159,26 @@ (if (null? (cdr args)) (list (transformer (car args))) (cons (list not (transformer (car args))) - (cons #f + (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)) #f) + (cond ((null? (cdr exp)) %nil) ((null? (cddr exp)) (transformer (cadr exp))) (else (cons nil-cond @@ -183,15 +193,15 @@ (procedure->memoizing-macro (lambda (exp env) (if (null? (cdr exp)) - #f + %nil (cons nil-cond (let loop ((clauses (cdr exp))) (if (null? clauses) - '(#f) + (list %nil) (let ((clause (car clauses))) (if (eq? (car clause) #t) - (cond ((null? (cdr clause)) '(t)) + (cond ((null? (cdr clause)) (list #t)) ((null? (cddr clause)) (list (transformer (cadr clause)))) (else `((,begin ,@(map transformer (cdr clause)))))) @@ -210,7 +220,7 @@ (,nil-cond ,(transformer (cadr exp)) (,begin ,@(map transformer (cddr exp)) (%--while)) - #f)))) + ,%nil)))) %--while))))) ;;; {Local binding} @@ -218,13 +228,13 @@ (fset 'let (procedure->memoizing-macro (lambda (exp env) - `(@bind ,(map (lambda (binding) - (trc 'let binding) - (if (pair? binding) - `(,(car binding) ,(transformer (cadr binding))) - `(,binding #f))) - (cadr exp)) - ,@(map transformer (cddr exp)))))) + `(, @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 @@ -234,11 +244,11 @@ (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 #f)))) - ,@(loop (cdr bindings))))))))))) + `((, @bind (,(let ((binding (car bindings))) + (if (pair? binding) + `(,(car binding) ,(transformer (cadr binding))) + `(,binding ,%nil)))) + ,@(loop (cdr bindings))))))))))) ;;; {Exception handling} diff --git a/lang/elisp/transform.scm b/lang/elisp/transform.scm index 0221dcc8a..f594c10cb 100644 --- a/lang/elisp/transform.scm +++ b/lang/elisp/transform.scm @@ -5,81 +5,98 @@ #:use-module (ice-9 session) #:export (transformer transform)) -;;; {S-expressions} +;;; 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)) -;; Should be made mutating instead of constructing -;; +(define-macro (scheme exp . module) + (let ((m (resolve-module (if (null? module) + '(guile-user) + (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) - ((null? x) %nil) - ((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) `(,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) (cons 'begin (map transformer (cdr x)))) - ;((cond) (m-cond x '())) - ;((lambda) (transform-lambda/interactive x '<elisp-lambda>)) - ;((defun) (m-defun x '())) - ;((defmacro) (m-defmacro x '())) - ;((setq) (m-setq x '())) - ;((interactive) (fluid-set! interactive-spec x) #f) - ;((unwind-protect) (m-unwind-protect x '())) - (else (transform-application x)))) - (else (syntax-error x)))) + ;; Could add other translations here, notably `?A' -> 65 etc. + (else x))) -(define (m-quasiquote exp env) - (cons quasiquote - (map transform-inside-qq (cdr exp)))) +(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-inside-qq x) - (trc 'transform-inside-qq x) - (cond ((not (pair? x)) 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 (car x) (map transform-inside-qq (cdr x)))))) + (else (cons-source x + (transform-datum (car x)) + (transform-quasiquote (cdr x)))))) (else - (cons (transform-inside-qq (car x)) (transform-inside-qq (cdr x)))))) + (cons-source x + (transform-quasiquote (car x)) + (transform-quasiquote (cdr x)))))) (define (transform-application x) - (cons-source x - '@fop - `(,(car x) (,transformer-macro ,@(cdr 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 'list (map transformer (cdr exp))))))) - -(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)))))) + (cons-source exp list (map transformer (cdr exp))))))) (define transform transformer) |