blob: e3e66172b809367a70917a5d895903c27edb0431 (
about) (
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 tree-eval (environment node)
(cond ((null node)
nil)
((object-symbol-p node)
(get-var environment (object-value 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)
"1~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)))
(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))
(tree-eval environment (rest node))))))
|
