+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,
* 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.
*** 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
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
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)
currently results from calling `(load-emacs)', see above in the Status
section.
-* nil, #f and '()
-
-For Jim Blandy's notes on this, see the reference at the bottom of
-this file. Currently I'm investigating a different approach, which is
-better IMO than Jim's proposal because it avoids requiring multiple
-false values in the Scheme world.
-
-According to my approach...
-
-- `nil' and `t' are read (when in Elisp mode) as #f and #t.
-
-- `(if x ...)', `(while x ...)' etc. are translated to something
- like `(if (and x (not (null? x))) ...)'.
-
-- Functions which interpret an argument as a list --
- `cons', `setcdr', `memq', etc. -- either convert #f to '(), or
- handle the #f case specially.
-
-- `eq' treats #f and '() as the same.
-
-- Optionally, functions which produce '() values -- i.e. the reader
- and `cdr' -- could convert those immediately to #f. This shouldn't
- affect the validity of any Elisp code, but it alters the balance of
- #f and '() values swimming around in that code and so affects what
- happens if two such values are returned to the Scheme world and then
- compared. However, since you can never completely solve this
- problem (unless you are prepared to convert arbitrarily deep
- structures on entry to the Elisp world, which would kill performance),
- I'm inclined not to try to solve it at all.
-
* Resources
** Ken Raeburn's Guile Emacs page
http://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.
--- /dev/null
+ -*-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.
(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
;; 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"))
(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.
#: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
"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}."
(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
`(((,> %--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))
(,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)))
(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))))
(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 'featurep
(lambda (feature)
- (memq feature features)))
+ (->nil (memq feature features))))
(fset 'require
(lambda* (feature #:optional file-name noerror)
(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)
(fset 'subrp
(lambda (obj)
- (not (not-subr? obj))))
+ (->nil (not (not-subr? obj)))))
(fset 'byte-code-function-p
(lambda (object)
#: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)
(fset 'car
(lambda (l)
(if (null l)
- #f
+ %nil
(car l))))
(fset 'cdr
(lambda (l)
(if (null l)
- #f
+ %nil
(cdr l))))
(fset 'eq
(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
(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))
(lambda (n list)
(if (or (null list)
(>= n (length list)))
- #f
+ %nil
(list-ref list n))))
(fset 'listp
(lambda args
#t))
-(define-public current-load-list #f)
+(define-public current-load-list %nil)
(iota (match:count match))))
#f)))
- (if last-match (car last-match) #f)))
+ (if last-match (car last-match) %nil)))
(fset 'match-beginning
(lambda (subexp)
(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 '> >)
(- shift 1))))))
lsh))
-(fset 'numberp number?)
+(fset 'numberp (lambda->nil number?))
(fset 'purecopy identity)
-(define-public purify-flag #f)
+(define-public purify-flag %nil)
(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 'number-to-string number->string)
-(fset 'string-lessp string<?)
+(fset 'string-lessp (lambda->nil string<?))
(fset 'string< 'string-lessp)
(fset 'aref
((string? array) (char->integer (string-ref array idx)))
(else (wta 'arrayp array 1)))))
-(fset 'stringp string?)
+(fset 'stringp (lambda->nil string?))
(fset 'vector vector)
(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}
(fset 'boundp
(lambda (sym)
- (module-defined? the-elisp-module sym)))
+ (->nil (module-defined? the-elisp-module sym))))
(fset 'default-boundp 'boundp)
(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)
`(,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
`(((,> %--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}
(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
(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
(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))))))
(,nil-cond ,(transformer (cadr exp))
(,begin ,@(map transformer (cddr exp))
(%--while))
- #f))))
+ ,%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 #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
(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}
-(define-module (lang elisp transform)
- #:use-module (lang elisp internals trace)
- #:use-module (lang elisp internals fset)
- #:use-module (lang elisp internals evaluation)
- #:use-module (ice-9 session)
- #:export (transformer transform))
-
-;;; {S-expressions}
-;;;
-
-(define (syntax-error x)
- (error "Syntax error in expression" x))
-
-;; Should be made mutating instead of constructing
-;;
-(define (transformer 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))))
-
-(define (m-quasiquote exp env)
- (cons quasiquote
- (map transform-inside-qq (cdr exp))))
-
-(define (transform-inside-qq x)
- (trc 'transform-inside-qq x)
- (cond ((not (pair? x)) x)
- ((symbol? (car x))
- (case (car x)
- ((unquote) (list 'unquote (transformer (cadr x))))
- ((unquote-splicing) (list 'unquote-splicing (transformer (cadr x))))
- (else (cons (car x) (map transform-inside-qq (cdr x))))))
- (else
- (cons (transform-inside-qq (car x)) (transform-inside-qq (cdr x))))))
-
-(define (transform-application x)
- (cons-source x
- '@fop
- `(,(car x) (,transformer-macro ,@(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))))))
-
-(define transform transformer)
+(define-module (lang elisp transform)
+ #:use-module (lang elisp internals trace)
+ #:use-module (lang elisp internals fset)
+ #:use-module (lang elisp internals evaluation)
+ #:use-module (ice-9 session)
+ #:export (transformer 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-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)
+ ;; 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)
HCoop / bpt / guile.git / commitdiff