diff options
Diffstat (limited to 'src/core.lisp')
| -rw-r--r-- | src/core.lisp | 32 | 
1 files changed, 22 insertions, 10 deletions
| diff --git a/src/core.lisp b/src/core.lisp index 6c151ce..d3c396b 100644 --- a/src/core.lisp +++ b/src/core.lisp @@ -16,7 +16,9 @@                         ,@body)                     ',args                     nil -                   (complement #'identity)))) +                   (complement #'identity) +                   nil +                   :function)))  (defmacro define-function* (name (&rest args) (siblings group-predicate)                              &body body) @@ -24,14 +26,18 @@                       ,@body)                   ',args                   nil -                 ,group-predicate)) +                 ,group-predicate +                 nil +                 :function))  (defmacro define-syntax (name (&rest args) &body body)    `(make-closure #'(lambda (environment siblings ,@args)                       ,@body)                   ',args                   t -                 (complement #'identity))) +                 (complement #'identity) +                 nil +                 :special))  (defmacro define-syntax* (name (&rest args) (siblings group-predicate)                            &body body) @@ -39,7 +45,9 @@                       ,@body)                   ',args                   t -                 ,group-predicate)) +                 ,group-predicate +                 nil +                 :special))  (defparameter *lambda*    (define-syntax lambda (arglist body) @@ -52,8 +60,9 @@                                              env                                              environment)                                      body)) -                     arglist nil (complement #'identity) env)))) +                     arglist nil (complement #'identity) env :function)))) +;; Is this basically quasiquote?  (defparameter *syntax*    (define-syntax syntax (arglist body)      (setf arglist (remove-if #'whitespace-text-p arglist)) @@ -61,11 +70,14 @@      (setf arglist (mapcar #'cdr arglist))      (let ((env environment))        (make-closure  #'(lambda (environment siblings &rest args) -                         (tree-eval (append (pairlis arglist args) -                                            env -                                            environment) -                                    body)) -                     arglist t (complement #'identity) env)))) +                         (mapc #'(lambda (pair) +                                   (setf body (nsubst (cdr pair) +                                                      `((symbol . ,(car pair))) +                                                      body +                                                      :test #'equal))) +                               (pairlis arglist args)) +                         body) +                     arglist t (complement #'identity) env :syntax))))  (defparameter *define*    (define-syntax* define (name value) (siblings #'identity) | 
