From f5cb35b87255ebbe2d322bcedde6bc7d5f6aebae Mon Sep 17 00:00:00 2001 From: Thomas Albers Raviola Date: Mon, 13 May 2024 21:29:31 +0200 Subject: * Initial commit --- src/eval.lisp | 44 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 44 insertions(+) create mode 100644 src/eval.lisp (limited to 'src/eval.lisp') diff --git a/src/eval.lisp b/src/eval.lisp new file mode 100644 index 0000000..4962ade --- /dev/null +++ b/src/eval.lisp @@ -0,0 +1,44 @@ +(in-package #:chains) + +(defun chainp (object) + (and (consp object) (eq (first object) 'chain))) + +(defun chain-links (chain) + (rest chain)) + +(defun object-symbolp (object) + (and (consp object) (eq (first object) 'symbol))) + +(defun tree-eval (environment node) + (cond ((null node) + nil) + ((object-symbolp node) + (get-var environment (cdr node))) + ((not (consp node)) + node) + ((chainp (first node)) + (destructuring-bind (flink &rest rlinks) (chain-links (first node)) + (setf flink (tree-eval environment flink)) + (assert (and (consp flink) + (closurep (first flink)) + (null (rest flink))) + (flink) + "~A ~A" flink (content (second flink))) + (let* ((closure (first flink)) + (function (closure-function closure)) + (group-predicate (closure-group-p closure))) + (multiple-value-bind (siblings rest) + (group-if group-predicate (rest node)) + (append + ;; 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)))))) + (tree-eval environment rest)))))) + (t + (cons (tree-eval environment (first node)) + (tree-eval environment (rest node)))))) -- cgit v1.2.3