From a92f076cf8279284b7e10d3b38aa5389cd395e1a Mon Sep 17 00:00:00 2001 From: Robin Templeton Date: Mon, 4 Aug 2014 23:11:29 -0400 Subject: [PATCH] compiler macros --- module/language/elisp/boot.el | 12 ++++++++++++ module/language/elisp/compile-tree-il.scm | 12 ++++++++++++ 2 files changed, 24 insertions(+) diff --git a/module/language/elisp/boot.el b/module/language/elisp/boot.el index bef4c1d7c..fe9af290f 100644 --- a/module/language/elisp/boot.el +++ b/module/language/elisp/boot.el @@ -41,6 +41,18 @@ (eval-when-compile ,@body) (progn ,@body))) +(defmacro %define-compiler-macro (name args &rest body) + `(eval-and-compile + (%funcall + (@ (language elisp runtime) set-symbol-plist!) + ',name + (%funcall + (@ (guile) cons*) + '%compiler-macro + #'(lambda ,args ,@body) + (%funcall (@ (language elisp runtime) symbol-plist) ',name))) + ',name)) + (eval-and-compile (defun eval (form) (%funcall (@ (language elisp runtime) eval-elisp) form))) diff --git a/module/language/elisp/compile-tree-il.scm b/module/language/elisp/compile-tree-il.scm index b23d93929..87ee48670 100644 --- a/module/language/elisp/compile-tree-il.scm +++ b/module/language/elisp/compile-tree-il.scm @@ -782,6 +782,11 @@ (make-void loc)) (else (report-error loc "bad %set-lexical-binding-mode" args)))) +(define (eget s p) + (if (symbol-fbound? 'get) + ((symbol-function 'get) s p) + #nil)) + ;;; Compile a compound expression to Tree-IL. (define (compile-pair loc expr) @@ -794,6 +799,13 @@ ((find-operator operator 'macro) => (lambda (macro-function) (compile-expr (apply macro-function arguments)))) + ((and (symbol? operator) + (eget operator '%compiler-macro)) + => (lambda (compiler-macro-function) + (let ((new (compiler-macro-function expr))) + (if (eq? new expr) + (compile-expr `(%funcall (%function ,operator) ,@arguments)) + (compile-expr new))))) (else (compile-expr `(%funcall (%function ,operator) ,@arguments)))))) -- 2.20.1