diff options
Diffstat (limited to 'lang/elisp/transform.scm')
-rw-r--r-- | lang/elisp/transform.scm | 111 |
1 files changed, 0 insertions, 111 deletions
diff --git a/lang/elisp/transform.scm b/lang/elisp/transform.scm deleted file mode 100644 index ee288a722..000000000 --- a/lang/elisp/transform.scm +++ /dev/null @@ -1,111 +0,0 @@ -(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 (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) |