blob: 4962adee42e970ef589327b7c70c78d23111e83d (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
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))))))
|
