Add syntax form for writing macros

* src/core.lisp (syntax): Change evaluation rules to replace arguments inside
macro expansion.
* src/eval.lisp (tree-eval): Add Evaluation route for chains with a syntax
closure.
* t/test4.chn: New file.

7 files changed, 114 insertions, 20 deletions

diff --git a/.gitignore b/.gitignore
index e5aa101..5d49f1a 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1,2 +1,4 @@
 sandbox.lisp
 archive/*
+notes
+t/test*.html
diff --git a/README.md b/README.md
index 0f030a8..b6b4f60 100644
--- a/README.md
+++ b/README.md
@@ -96,3 +96,4 @@ with your patch to the following address: thomas _at_ thomaslabs _dot_ org
 ;; type 2 - {{@lambda}{@x @y}{@x}}{Hello}{World}
 
 ;; semantically. What exactly is a chain?
+;; is syntax just like define-syntax in scheme?
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)
diff --git a/src/eval.lisp b/src/eval.lisp
index 4962ade..eede4ad 100644
--- a/src/eval.lisp
+++ b/src/eval.lisp
@@ -23,7 +23,7 @@
                         (closurep (first flink))
                         (null (rest flink)))
                    (flink)
-                   "~A ~A" flink (content (second flink)))
+                   "1~A ~A" flink (content (second flink)))
            (let* ((closure (first flink))
                   (function (closure-function closure))
                   (group-predicate (closure-group-p closure)))
@@ -33,11 +33,20 @@
                 ;; Evaluating a function returns a sublink, flatten all sublink
                 (flatten
                  (let ((eval-with-environment (curry #'tree-eval environment)))
-                   (if (closure-special-p closure)
-                       (ensure-list (apply function environment siblings rlinks))
-                       (let ((args (mapcar eval-with-environment rlinks))
-                             (siblings (funcall eval-with-environment siblings)))
-                         (ensure-list (apply function environment siblings args))))))
+                   (case (closure-type closure)
+                     (:syntax
+                      (let ((body (ensure-list (apply function environment siblings rlinks)))
+                            (ret nil))
+                        ;; (format t "~&Body: ~A~%" body)
+                        (setf ret (tree-eval environment (append body (rest node))))
+                        (setf rest nil)
+                        ret))
+                     (:special
+                      (ensure-list (apply function environment siblings rlinks)))
+                     (:function
+                      (let ((args (mapcar eval-with-environment rlinks))
+                            (siblings (funcall eval-with-environment siblings)))
+                        (ensure-list (apply function environment siblings args)))))))
                 (tree-eval environment rest))))))
         (t
          (cons (tree-eval environment (first node))
diff --git a/src/types.lisp b/src/types.lisp
index 09ede2b..06183b1 100644
--- a/src/types.lisp
+++ b/src/types.lisp
@@ -36,15 +36,20 @@
              :initarg :specialp
              :type boolean
              :documentation "")
+   (type :reader closure-type
+         :initarg :type
+         :type keyword
+         :documentation "")
    (groupp :reader closure-group-p
            :initarg :groupp
            :type function
            :documentation "")))
 
-(defun make-closure (function arg-list specialp groupp &optional environment)
+(defun make-closure (function arg-list specialp groupp &optional environment type)
   (make-instance 'closure :function function :arg-list arg-list
                           :specialp specialp :groupp groupp
-                          :environment environment))
+                          :environment environment
+                          :type type))
 
 (defun closurep (object)
   (typep object 'closure))
diff --git a/t/test3.chn b/t/test3.chn
index d989187..42a0b97 100644
--- a/t/test3.chn
+++ b/t/test3.chn
@@ -1,3 +1,3 @@
 {@define}{@define-function}{{@syntax}{@name @args @body}{{@define}{@name}{{@lambda}{@args}{@body}}}}%
-{@define-function}{@foo}{@a}{hola @a}%
-%{@foo}{mundo}
+{@define-function}{@foo}{@a @b}{hola @b}%
+{@foo}{mundo}{casa}
diff --git a/t/test4.chn b/t/test4.chn
new file mode 100644
index 0000000..e126091
--- /dev/null
+++ b/t/test4.chn
@@ -0,0 +1,65 @@
+{@define}{@title}{Method for solving first order and Bernoulli's differential equations}
+{@define}{@author}{Thomas Albers Raviola}
+{@define}{@date}{2022-10-01}
+%
+{@template}
+{@section}{History}
+I came across the method concerning this article in an old math book from Doctor
+Granville (Elements of differential and integral calculus - ISBN-13:
+978-968-18-1178-5). It doesn't appear to be a popular technique as when using it
+for my assignments I always had to explain what I was doing. As of yet, I still
+haven't found another text referencing it, which is why I decided to include it
+in my website.
+
+In the original book this procedure is shown but never really explained, it is
+left as a sort of "it just works" thing. Here is my attempt to it clear.
+
+{@section}{Theory}
+Throughout this article we'll consider first order differential equations with
+function coefficients just as a special case of the Bernoulli's differential
+equation with {@eq*}{n = 0}.
+
+Consider now the following ODE:
+{@equation}{
+y' + P(x)y = Q(x)y^n
+}
+
+let {@eq*}{y} be the product of two arbitrary functions {@eq*}{w} and {@eq*}{z}
+such that
+
+{@equation}{
+y &= wz \\
+y' &= w'z + wz'
+}
+
+we now restrict {@eq*}{z} to be the solution of the ODE
+
+{@equation}{
+z' + P(x)z = 0
+}
+
+with this it is possible to solve for {@eq*}{z} by integrating
+
+{@equation}{
+\frac{z'}{z} = - P(x)
+}
+
+using {@eq}{z} we solve for {@eq}{w} by replacing {@eq}{y} inside the original
+ODE
+
+{@align}{
+w'z + wz' + P(x)wz &= Q(x)w^nz^n \\
+w'z + w\left(z' + P(x)z\right) &= Q(x)w^nz^n \\
+w'z &= Q(x)w^nz^n \\
+\frac{w'}{w^n} &= Q(x)z^{n-1}
+}
+
+the general solution to our original ODE can be simply obtained by multiplying
+{@eq*}{w} and {@eq*}{z}.
+
+{@section}{Comments}
+This method, while functional, may not always be the most practical. In some
+cases the differential equations for $w$ and $z$ may not have closed algebraic
+solutions. A more traditional substitution may in some situations also be easier
+than this method. Like always it is up to one to know which tool to apply for a
+given problem.