3
$Id: data.jl,v 1.10 2001/06/28 18:42:51 jsh Exp $
5
Copyright (C) 2000 John Harper <john@dcs.warwick.ac.uk>
7
This file is part of librep.
9
librep is free software; you can redistribute it and/or modify it
10
under the terms of the GNU General Public License as published by
11
the Free Software Foundation; either version 2, or (at your option)
14
librep is distributed in the hope that it will be useful, but
15
WITHOUT ANY WARRANTY; without even the implied warranty of
16
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17
GNU General Public License for more details.
19
You should have received a copy of the GNU General Public License
20
along with librep; see the file COPYING. If not, write to
21
the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
24
(declare (in-module rep.data))
26
(open-structures '(rep.regexp
29
(defun assoc-regexp (input alist #!optional fold-case)
30
"Scan ALIST for an element whose car is a regular expression matching the
34
(when (string-match (car cell) input nil fold-case)
35
(throw 'return cell))) alist)))
37
(defun setcar (cell x) (rplaca cell x) x)
38
(defun setcdr (cell x) (rplacd cell x) x)
40
;; Some function pseudonyms
41
(%define string= equal)
44
(defun member-if (fun lst)
45
"Similar to the `member' function, except that the function FUN is
46
called to test the elements for matches. If `(FUN ELT)' returns true,
47
then the sublist starting with ELT is returned."
48
(cond ((null lst) '())
50
(t (member-if fun (cdr lst)))))
52
(defun remove-if (pred lst)
53
"Returns a new copy of LST with any elements removed for which (PRED ELT)
57
(cond ((null rest) (nreverse out))
58
((pred (car rest)) (loop (cdr rest) out))
59
(t (loop (cdr rest) (cons (car rest) out))))))
61
(defun remove-if-not (fun lst)
62
"Returns a new copy of LST with any elements removed for which (PRED ELT)
64
(remove-if (lambda (x) (not (fun x))) lst))
66
(defun remove (elt lst)
67
"Returns a new copy of LST with all elements `equal' to ELT discarded."
68
(remove-if (lambda (x) (equal x elt)) lst))
71
"Returns a new copy of LST with all elements `eq' to ELT discarded."
72
(remove-if (lambda (x) (eq x elt)) lst))
74
(export-bindings '(assoc-regexp setcar setcdr string= string<
75
member-if remove-if remove-if-not remove remq))
80
(defun caar (x) (car (car x)))
81
(defun cdar (x) (cdr (car x)))
82
(defun cadr (x) (car (cdr x)))
83
(defun cddr (x) (cdr (cdr x)))
85
(defun caaar (x) (car (caar x)))
86
(defun cdaar (x) (cdr (caar x)))
87
(defun cadar (x) (car (cdar x)))
88
(defun cddar (x) (cdr (cdar x)))
89
(defun caadr (x) (car (cadr x)))
90
(defun cdadr (x) (cdr (cadr x)))
91
(defun caddr (x) (car (cddr x)))
92
(defun cdddr (x) (cdr (cddr x)))
94
(defun caaaar (x) (caar (caar x)))
95
(defun cadaar (x) (cadr (caar x)))
96
(defun caadar (x) (caar (cdar x)))
97
(defun caddar (x) (cadr (cdar x)))
98
(defun caaadr (x) (caar (cadr x)))
99
(defun cadadr (x) (cadr (cadr x)))
100
(defun caaddr (x) (caar (cddr x)))
101
(defun cadddr (x) (cadr (cddr x)))
102
(defun cdaaar (x) (cdar (caar x)))
103
(defun cddaar (x) (cddr (caar x)))
104
(defun cdadar (x) (cdar (cdar x)))
105
(defun cdddar (x) (cddr (cdar x)))
106
(defun cdaadr (x) (cdar (cadr x)))
107
(defun cddadr (x) (cddr (cadr x)))
108
(defun cdaddr (x) (cdar (cddr x)))
109
(defun cddddr (x) (cddr (cddr x)))
111
(export-bindings '(caar cdar cadr cddr caaar cdaar cadar cddar caadr
112
cdadr caddr cdddr caaaar cadaar caadar caddar
113
caaadr cadadr caaddr cadddr cdaaar cddaar cdadar
114
cdddar cdaadr cddadr cdaddr cddddr))
119
(defun vector->list (vec)
121
(out '() (cons (aref vec i) out)))
122
((= i (length vec)) (nreverse out))))
124
(defun list->vector (lst)
127
(export-bindings '(vector->list list->vector))
132
(defun make-guardian ()
133
"Create a new guardian. Guardians provide a means of protecting data
134
objects from deallocation when they have no extant references.
136
`make-guardian' returns a function representing a single guardian.
137
Calling this function with a single argument adds that value to the
138
list of objects protected by the guardian. Calling the function with no
139
arguments returns one of the objects that would otherwise have been
140
deallocated by the garbage collector, or false if no such objects
141
exist that have not already been returned."
142
(let ((g (make-primitive-guardian)))
145
(primitive-guardian-push g (car args))
146
(primitive-guardian-pop g)))))
148
(export-bindings '(make-guardian))
153
(autoload 'string-upper-case-p "rep/data/string-util")
154
(autoload 'string-lower-case-p "rep/data/string-util")
155
(autoload 'string-capitalized-p "rep/data/string-util")
156
(autoload 'string-upcase "rep/data/string-util")
157
(autoload 'string-downcase "rep/data/string-util")
158
(autoload 'capitalize-string "rep/data/string-util")
159
(autoload 'mapconcat "rep/data/string-util")
160
(autoload 'sort "rep/data/sort")
162
(export-bindings '(string-upper-case-p string-lower-case-p string-capitalized-p
163
string-upcase string-downcase capitalize-string
164
mapconcat sort upcase-table downcase-table flatten-table))
added
removed
lisp/rep/data.jl
