Last active
May 4, 2016 21:39
-
-
Save ejbs/768190e11dc066b4972db5276b4e9400 to your computer and use it in GitHub Desktop.
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
;; http://blog.hostilefork.com/rebol-vs-lisp-macros/ | |
(ql:quickload '( :alexandria :closer-mop)) | |
(in-package :closer-mop) | |
(use-package :alexandria) | |
(defvar *env* ()) | |
(defclass fexpr (funcallable-standard-object) | |
((env :accessor env :initform nil :initarg :env) | |
(src :accessor src :initform nil :initarg :src) | |
(effective-fn :accessor fn :initform nil)) | |
(:metaclass funcallable-standard-class)) | |
(defun make-fexpr (src &optional (env *dynamic-env*)) | |
(let ((fexpr | |
(make-instance 'fexpr :env env :src src))) | |
(setf (fn fexpr) | |
`(let (,@env) | |
,(src fexpr))) | |
(set-funcallable-instance-function fexpr (lambda () (eval (fn fexpr)))) | |
fexpr)) | |
(defmethod (setf env) :after (nenv fexpr) | |
(setf (fn fexpr) | |
`(let (,@nenv) | |
,(src fexpr)))) | |
(defmethod (setf src) :after (nsrc fexpr) | |
(setf (fn fexpr) | |
`(let (,@(env fexpr)) | |
,nsrc))) | |
(defmacro use ((&rest vars) &body body) | |
`(let ((*env* ',vars) | |
(vars ',vars)) | |
,@body)) | |
(set-macro-character #\[ | |
(lambda (s c) | |
(declare (ignore c)) | |
`(make-fexpr ',(read-delimited-list #\] s)))) | |
(set-macro-character #\] (get-macro-character #\) nil)) | |
;; example: | |
;; (use ((a 10) (b 5)) (let (( fn [+ a b])) (funcall fn))) | |
;; => 15 | |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment