diff options
| -rw-r--r-- | .gitignore | 2 | ||||
| -rw-r--r-- | README.md | 1 | ||||
| -rw-r--r-- | src/core.lisp | 32 | ||||
| -rw-r--r-- | src/eval.lisp | 21 | ||||
| -rw-r--r-- | src/types.lisp | 9 | ||||
| -rw-r--r-- | t/test3.chn | 4 | ||||
| -rw-r--r-- | t/test4.chn | 65 |
7 files changed, 114 insertions, 20 deletions
@@ -1,2 +1,4 @@ sandbox.lisp archive/* +notes +t/test*.html @@ -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. |