aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorThomas Albers Raviola <thomas@thomaslabs.org>2024-05-15 16:21:29 +0200
committerThomas Albers Raviola <thomas@thomaslabs.org>2024-05-15 16:21:29 +0200
commitd917f41beca176b8f2b682ac3a2c25b148752b71 (patch)
tree7dca0da8e57841f2f8efa31783196888511002cd
parentf5cb35b87255ebbe2d322bcedde6bc7d5f6aebae (diff)
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.
-rw-r--r--.gitignore2
-rw-r--r--README.md1
-rw-r--r--src/core.lisp32
-rw-r--r--src/eval.lisp21
-rw-r--r--src/types.lisp9
-rw-r--r--t/test3.chn4
-rw-r--r--t/test4.chn65
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.