add GC for QGET, QFUN return values; fix possible memory leaks (e.g. overridden metho...
[eql:eql.git] / src / lisp / x.lisp
1 ;;; copyright (c) 2010-2011 Polos Ruetz
2
3 (defpackage :x
4   (:use :common-lisp)
5   (:export
6    #:bytes-to-string
7    #:d
8    #:do-string
9    #:do-with
10    #:empty-string
11    #:ensure-list
12    #:ends-with
13    #:it
14    #:it*
15    #:if-it
16    #:if-it*
17    #:join
18    #:split
19    #:starts-with
20    #:string-substitute
21    #:string-to-bytes
22    #:when-it
23    #:when-it*
24    #:while
25    #:with-gensyms))
26
27 (provide :x)
28
29 (in-package :x)
30
31 (defmacro if-it (exp then &optional else)
32   `(let ((it ,exp))
33     (if it ,then ,else)))
34
35 (defmacro if-it* (exp then &optional else)
36   `(let ((it* ,exp))
37     (if it* ,then ,else)))
38
39 (defmacro when-it (exp &body body)
40   `(let ((it ,exp))
41     (when it ,@body)))
42
43 (defmacro when-it* (exp &body body)
44   `(let ((it* ,exp))
45     (when it* ,@body)))
46
47 (defmacro with-gensyms (syms &body body)
48   `(let ,(mapcar (lambda (s)
49                    `(,s (gensym)))
50                  syms)
51      ,@body))
52
53 (defmacro while (exp &body body)
54   `(do ()
55        ((not ,exp))
56      ,@body))
57
58 (defmacro do-string ((var str) &body body)
59   `(map nil (lambda (,var)
60               ,@body)
61         ,str))
62
63 (defmacro do-with (with &body body)
64   `(progn
65      ,@(mapcar (lambda (line)
66                  (append with (if (or (atom line)
67                                       (eql 'quote (first line)))
68                                   (list line)
69                                   line)))
70                body)))
71
72 (defun d (&rest args)
73   "A simple debug print."
74   (print (cons :debug args)))
75
76 (defun empty-string (s)
77   (zerop (length s)))
78
79 (defun str-with (sub str starts)
80   (let ((l1 (length str))
81         (l2 (length sub)))
82     (when (>= l1 l2)
83       (string= sub (subseq str (if starts 0 (- l1 l2)) (when starts l2))))))
84
85 (defun starts-with (sub str)
86   (str-with sub str t))
87
88 (defun ends-with (sub str)
89   (str-with sub str nil))
90
91 (defun string-substitute (new old str)
92   (let ((l (length old)))
93     (with-output-to-string (s)
94       (do ((e (search old str) (search old str :start2 (+ e l)))
95            (b 0 (+ e l)))
96           ((not e) (write-string (subseq str b) s))
97         (write-string (subseq str b e) s)
98         (write-string new s)))))
99
100 (defun ensure-list (x)
101   (if (listp x) x (list x)))
102
103 (defun split (str &optional (sep #\Space))
104   (unless (zerop (length str))
105     (let (lst)
106       (do ((e (position sep str) (position sep str :start (1+ e)))
107            (b 0 (1+ e)))
108           ((not e) (push (subseq str b) lst))
109         (push (subseq str b e) lst))
110       (nreverse lst))))
111
112 (defun join (lst &optional (sep #\Space))
113   (format nil (format nil "~~{~~A~~^~A~~}" sep) lst))
114
115 (defun bytes-to-string (b)
116   (map 'string 'code-char b))
117
118 (defun string-to-bytes (s)
119   (map 'vector 'char-code s))