blob: 09ede2baaba4df59210494f62df36d1a0eb3f58e (
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
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
|
(in-package #:chains)
(defclass text ()
((content :reader content
:initarg :content
:type string
:documentation "")))
(defun textp (object)
(typep object 'text))
(defun make-text (content)
(make-instance 'text :content content))
(defun concat-text (&rest text)
(let ((strings (mapcar #'content text)))
(make-text (apply #'concatenate 'string strings))))
(defmethod content ((object (eql 'empty-line)))
(list (make-text "")))
(defclass closure ()
((function :reader closure-function
:initarg :function
:type function
:documentation "")
(arg-list :reader closure-arg-list
:initarg :arg-list
:type list
:documentation "")
(environment :reader closure-environment
:initarg :environment
:type list
:documentation "")
(specialp :reader closure-special-p
:initarg :specialp
:type boolean
:documentation "")
(groupp :reader closure-group-p
:initarg :groupp
:type function
:documentation "")))
(defun make-closure (function arg-list specialp groupp &optional environment)
(make-instance 'closure :function function :arg-list arg-list
:specialp specialp :groupp groupp
:environment environment))
(defun closurep (object)
(typep object 'closure))
(defun group (item sequence &key (test #'eql))
(group-if #'(lambda (x) (funcall test item x)) sequence))
(defun group-if (predicate sequence)
(loop :for (head . tail) :on sequence
:while (funcall predicate head)
:collect head :into group
:finally
(return (values group (if (not (funcall predicate head))
(cons head tail)
tail)))))
(defun group-if-not (predicate sequence)
(group-if (complement predicate) sequence))
(defun whitespacep (char-or-string)
(if (stringp char-or-string)
(every #'whitespacep char-or-string)
(member char-or-string +whitespace+)))
(defun whitespace-text-p (object)
(and (textp object) (whitespacep (content object))))
(defun special-char-p (x)
(member x +special-characters+))
(defun empty-line-p (x)
(or (emptyp x) (every #'whitespacep x)))
(defun newlinep (x)
(eql x #\Newline))
(defun concat (&rest strings)
(apply #'concatenate 'string strings))
|
