blob: c845b2d4c0c3fad319f11fe1763a0bb01c772463 (
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
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
|
(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 "Environment captured by the closure")
(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 groupp &optional environment type)
(make-instance 'closure :function function :arg-list arg-list
:groupp groupp
:environment environment
:type type))
(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))
(defclass object ()
((type :reader object-type
:initarg :type
:type keyword
:documentation "")
(value :reader object-value
:initarg :value
:type t
:documentation "")))
(defun make-object (type value)
(make-instance 'object :type type :value value))
(defun objectp (object)
(typep object 'object))
(defun object-symbol-p (object)
(and (objectp object) (eq (object-type object) :symbol)))
(defmethod print-object ((object object) stream)
(format stream "#<OBJECT :TYPE ~A :VALUE ~A>"
(object-type object) (object-value object)))
(defclass chain ()
((links :reader chain-links
:initarg :links
:type list
:documentation "")))
(defun make-chain (links)
(make-instance 'chain :links links))
(defun chainp (object)
(typep object 'chain))
(defmethod print-object ((object chain) stream)
(format stream "#<CHAIN :LINKS ~A>" (chain-links object)))
|
