Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 376 lines (335 sloc) 9.173 kb
0cfcac04 »
2012-03-25 Follow more header conventions, in all .el and .scm files
1 ;;; fud.scm --- Scheme-side section of Fud -*- mode: Gimp; -*-
497da025 »
2008-08-03 * gimp-mode.el (gimp-comint-filter): add prettification to output
2
0cfcac04 »
2012-03-25 Follow more header conventions, in all .el and .scm files
3 ;; Copyright (C) 2008-2009, 2012 Niels Giesen.
4
5 ;; Author: Niels Giesen <niels.giesen@gmail.com>
6 ;; Keywords: processes, languages, multimedia, tools
2c211d66 »
2009-10-11 Updating version info for git, and Copyright notices + fixing email a…
7
8 ;; Author: Niels Giesen <nielsforkgiesen@gmailspooncom, but please
9 ;; replace the kitchen utensils with a dot before hitting "Send">
10 ;; Keywords: processes, multimedia, extensions, tools, gimp, scheme
11 ;; Homepage: http://niels.kicks-ass.org/gimpmode
497da025 »
2008-08-03 * gimp-mode.el (gimp-comint-filter): add prettification to output
12 ;; Keywords: lisp, tools, scheme, debugging
13
14 ;; This file is free software; you can redistribute it and/or modify
15 ;; it under the terms of the GNU General Public License as published by
16 ;; the Free Software Foundation; either version 2, or (at your option)
17 ;; any later version.
18
19 ;; This file is distributed in the hope that it will be useful,
20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
22 ;; GNU General Public License for more details.
23
24 ;; You should have received a copy of the GNU General Public License
25 ;; along with GNU Emacs; see the file COPYING. If not, write to
26 ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
27 ;; Boston, MA 02110-1301, USA.
28
29 ;;; Commentary:
30
e59731a9 »
2008-08-03 * fud.scm: add documentation
31 ;; FUD stands for the FU Debugger. It is developed for use
32 ;; with gimp-mode to debug code written in the TinyScheme
33 ;; implementation shipped with the GIMP, but its design is such that
34 ;; it could in principle work with any scheme.
497da025 »
2008-08-03 * gimp-mode.el (gimp-comint-filter): add prettification to output
35 ;;
e59731a9 »
2008-08-03 * fud.scm: add documentation
36 ;; It's basis is setting and handling break-points FUD.scm integrates
37 ;; with fud.el, which in turn is integrated in gimp-mode.
16c07e97 »
2008-08-01 * fud.el (Module): new FUD FU debugger - elisp side
38
39 (define (fud-prompt)
40 (newline)
41 (fud-write-string "FUD> "))
42
43 (define fud-result #f)
44
45 (define fud-recursion 0)
46
47 (define (fud-recursion++)
48 (set! fud-recursion
49 (+ 1 fud-recursion)))
50
51 (define (fud-recursion--)
52 (set! fud-recursion
53 (- fud-recursion 1)))
54
55 (define (fud-reset)
56 (set! fud-recursion 0))
57
58 (define (fud-write-string . strngs)
59 (display
60 (string-append
61 (make-string fud-recursion)
62 (unbreakupstr strngs ""))))
63
64 (define fud-tracing #t)
65
66 (define (fud-untrace)
67 (set! fud-tracing #f))
68
69 (define (fud-trace)
70 (set! fud-tracing #t))
71
497da025 »
2008-08-03 * gimp-mode.el (gimp-comint-filter): add prettification to output
72 (define (fud-inside-steppable? form)
73 (list? form))
16c07e97 »
2008-08-01 * fud.el (Module): new FUD FU debugger - elisp side
74
497da025 »
2008-08-03 * gimp-mode.el (gimp-comint-filter): add prettification to output
75 (define-macro (fud-log . form)
76 "Very simple logging."
77 `(let ((evalled (eval (car ',form))))
78 (newline)
79 (display "FUD log on")
80 (display evalled)
81 (newline)
82 evalled))
16c07e97 »
2008-08-01 * fud.el (Module): new FUD FU debugger - elisp side
83
0be7090f »
2008-08-03 (gimp-snippets): drop radio snippet, as the param
84 (define-macro (unfud f)
85 ;; "Remove instruction by fudify on function F"
86 (let
87 ((name f))
88 `(begin
89 (if
90 (not
91 (assq ',name fudlist))
92 (error
93 (string-append
94 (symbol->string ',f)
95 " is not fudified")))
96 (define ,f
97 (eval
98 (cadr
99 (assq ',name fudlist))))
100 (set! fudlist
101 (fud-delete
102 (assq ',name fudlist)
103 fudlist))
104 ',name)))
105
106 (define (fud-breakify sxp)
107 (list 'fud-break "0.0 file:nil" sxp))
108
16c07e97 »
2008-08-01 * fud.el (Module): new FUD FU debugger - elisp side
109 (define-macro (fud-break breakpoint . form)
110 `(begin
111 (when fud-tracing
112 (newline))
113 (fud-recursion++)
114 (when fud-tracing
115 (fud-write-string
116 (string-append "Break I-> " ,breakpoint))
117 (newline)
118 (fud-write-string "I: ")
119 (write (car ',form)))
120
121 (newline)
122 (fud-write-string
123 "ENTER: step over, "
497da025 »
2008-08-03 * gimp-mode.el (gimp-comint-filter): add prettification to output
124 (if (fud-inside-steppable? (car ',form))
125 " I: step inside" "")
16c07e97 »
2008-08-01 * fud.el (Module): new FUD FU debugger - elisp side
126 " Q: quit,"
497da025 »
2008-08-03 * gimp-mode.el (gimp-comint-filter): add prettification to output
127 " G: go"
128 " P: poke at environment,"
16c07e97 »
2008-08-01 * fud.el (Module): new FUD FU debugger - elisp side
129 " V: use value")
130 (fud-prompt)
131 (prog1
132 (call/cc
133 (lambda (return)
497da025 »
2008-08-03 * gimp-mode.el (gimp-comint-filter): add prettification to output
134 (let (($ #f))
135
136 ;; INPUT
137 (case (char-downcase (read-char))
138 ;; Go...
6086e6b1 »
2008-10-05 * gimp-mode.el (gimp-selector): Add ESC as binding to cancel the
139 ((#\g)
497da025 »
2008-08-03 * gimp-mode.el (gimp-comint-filter): add prettification to output
140 (display "Continued... (fud-trace) to trace again")
141 (newline)
142 (return (eval (car ',form))))
143 ;; Inside...
144 ((#\i)
145 (read-char)
146 (if (fud-inside-steppable? (car ',form))
147 (set! $ (eval (fud-instruct-1 (car ',form))))))
148 ;; Quit...
149 ((#\q)
150 (fud-reset)
151 (*error-hook* "Quit tracing"))
152 ;; Inspect...
153 ((#\p)
154 (letrec ((handler (lambda (err)
155 (display err) "")))
156 (display "Expression (q to quit inspection): ")
157 (fud-prompt)
158 (let loop ((expr (read)))
159 (cond ((eqv? 'q expr))
160 ((push-handler handler)
161 (fud-write-string "")
162 (write (eval expr))
163 (if (and (pair? *handlers*)
164 (eq? handler (car *handlers*)))
165 (pop-handler))
166 (newline)
167 (fud-write-string "Type expression: ")
168 (fud-prompt)
169 (loop (read)))))))
170 ;; Use value...
171 ((#\v)
172 (read-char)
173 (fud-write-string "Enter value: ")
16c07e97 »
2008-08-01 * fud.el (Module): new FUD FU debugger - elisp side
174 (fud-prompt)
497da025 »
2008-08-03 * gimp-mode.el (gimp-comint-filter): add prettification to output
175 (set! $ (eval (read)))
176 (read-char)))
177
178 ;; OUTPUT
179 (let (($ (or $ (eval (car ',form)))))
16c07e97 »
2008-08-01 * fud.el (Module): new FUD FU debugger - elisp side
180 (when fud-tracing
181 (fud-write-string
182
183 (string-append "Break O<- " ,breakpoint))
184
185 (display " on ")
186 (write (car ',form))
187 (newline)
188 (fud-write-string "O: ")
189 (write $)
190
191 (newline)
192 (fud-write-string
193 "ENTER: next breakpoint, "
194 " Q: quit,"
195 " G: go (skipping breakpoints),"
497da025 »
2008-08-03 * gimp-mode.el (gimp-comint-filter): add prettification to output
196 " P: poke at environment,"
16c07e97 »
2008-08-01 * fud.el (Module): new FUD FU debugger - elisp side
197 " V: use value")
198 (fud-prompt)
497da025 »
2008-08-03 * gimp-mode.el (gimp-comint-filter): add prettification to output
199
200 (case (char-downcase (read-char))
16c07e97 »
2008-08-01 * fud.el (Module): new FUD FU debugger - elisp side
201 ;; Go...
497da025 »
2008-08-03 * gimp-mode.el (gimp-comint-filter): add prettification to output
202 ((#\g)
16c07e97 »
2008-08-01 * fud.el (Module): new FUD FU debugger - elisp side
203 (display "Continued... (fud-trace) to trace again")
204 (newline)
205 (fud-untrace))
206 ;; Quit...
497da025 »
2008-08-03 * gimp-mode.el (gimp-comint-filter): add prettification to output
207 ((#\q)
16c07e97 »
2008-08-01 * fud.el (Module): new FUD FU debugger - elisp side
208 (fud-reset)
209 (*error-hook* (make-environment)))
210 ;; Inspect...
497da025 »
2008-08-03 * gimp-mode.el (gimp-comint-filter): add prettification to output
211 ((#\p)
16c07e97 »
2008-08-01 * fud.el (Module): new FUD FU debugger - elisp side
212 (letrec ((handler (lambda (err)
213 (display err) "")))
214 (display "Expression (q to quit inspection) current value is bound to `$': ")
215 (fud-prompt)
216 (let loop ((expr (read)))
217 (cond ((eqv? 'q expr))
497da025 »
2008-08-03 * gimp-mode.el (gimp-comint-filter): add prettification to output
218 ((push-handler handler)
16c07e97 »
2008-08-01 * fud.el (Module): new FUD FU debugger - elisp side
219 (fud-write-string "")
220 (write (eval expr))
221 (if (and (pair? *handlers*)
222 (eq? handler (car *handlers*)))
223 (pop-handler))
224 (newline)
225 (fud-write-string "Type expression: ")
226 (fud-prompt)
227 (loop (read)))))))
228 ;; Use value...
497da025 »
2008-08-03 * gimp-mode.el (gimp-comint-filter): add prettification to output
229 ((#\v)
16c07e97 »
2008-08-01 * fud.el (Module): new FUD FU debugger - elisp side
230 (fud-write-string "Enter value: ")
231 (fud-prompt)
497da025 »
2008-08-03 * gimp-mode.el (gimp-comint-filter): add prettification to output
232 (return (eval (read))))
233 (else (return $)))
234 (return $))))))
235 (fud-recursion--)
236 (if (= fud-recursion 0)
237 (fud-trace)))))
238
239 (define (fud-instruct-1 thunk)
0be7090f »
2008-08-03 (gimp-snippets): drop radio snippet, as the param
240 ;; "Instruct evaluatable members of THUNK with `fud-breakify'.
497da025 »
2008-08-03 * gimp-mode.el (gimp-comint-filter): add prettification to output
241
0be7090f »
2008-08-03 (gimp-snippets): drop radio snippet, as the param
242 ;; Special forms and macros supported are if, cond, let, let*, letrec, do
243 ;; and lambda. Forms BEGINNING with a symbol in `blacklist' are returned
244 ;; as is.
497da025 »
2008-08-03 * gimp-mode.el (gimp-comint-filter): add prettification to output
245
0be7090f »
2008-08-03 (gimp-snippets): drop radio snippet, as the param
246 ;; For instruction of functions and macros --blacklisted here--, see
247 ;; `fudify' and `unfud'."
497da025 »
2008-08-03 * gimp-mode.el (gimp-comint-filter): add prettification to output
248 (let ((in-let? #f)
249 (in-lambda? #f)
250 (in-do? #f)
251 (in-cond? #f)
252 (blacklist '(define define-macro))
253 (blacklisted? #f)
254 (num 0))
255 (if (eq? (car thunk) 'quote)
256 (cdr thunk))
257 (mapcar (lambda (th)
258 (set! num (+ 1 num))
259 (cond
260 ;; IF
261 ((and (= num 1)
262 (memq th '(if)))
263 th)
264 ;; COND
265 ((and (= num 1)
266 (memq th '(cond)))
267 (set! in-cond? #t)
268 'cond)
269 (in-cond?
270 (mapcar (lambda (clause)
271 (fud-breakify clause)) th))
272 ;; LET, LET* and LETREC
273 ((and (= num 1)
274 (memq th '(let let* letrec)))
275 (set! in-let? #t)
276 th)
277 (in-let?
278 (if (symbol? th) th
279 (begin
280 (set! in-let? #f)
281 (mapcar (lambda (th)
282 (list (car th)
283 (fud-breakify (cadr th)))) th))))
284 ;; DO
285 ((and (= num 1)
286 (memq th '(do)))
287 (set! in-do? 'bindings)
288 th)
289 ((eq? in-do? 'bindings)
290 (if (symbol? th) th
291 (begin
292 (set! in-do? 'test)
293 (mapcar (lambda (th)
294 (cond ((= (length th) 2)
295 (list (car th)
296 (fud-breakify (cadr th))))
297 ((= (length th) 3)
298 (list (car th)
299 (fud-breakify (cadr th))
300 (fud-breakify (caddr th))))))
301 th))))
302 ((eq? in-do? 'test)
303 (set! in-do? #f)
304 (list (car th)
305 (fud-breakify (cadr th))))
306 ;; LAMBDA
307 ((and (= num 1)
308 (memq th '(lambda)))
309 (set! in-lambda? #t)
310 'lambda)
311 (in-lambda?
312 (set! in-lambda? #f)
313 th)
314 ;; BLACKLISTED FORMS
315 ((or blacklisted?
316 (and (= num 1)
317 (memq th blacklist)))
318 (set! blacklisted? #t)
319 th)
320 (else
321 (fud-breakify th))))
322 thunk)))
323
324 ;; Instruction of functions:
0be7090f »
2008-08-03 (gimp-snippets): drop radio snippet, as the param
325 (define (fud-delete item lst)
497da025 »
2008-08-03 * gimp-mode.el (gimp-comint-filter): add prettification to output
326 (let
327 ((out
328 '()))
329 (map
330 (lambda
331 (item-in-list)
332 (if
333 (not
334 (equal? item item-in-list))
335 (set! out
336 (cons item-in-list out))))
337 lst)
338 (if
339 (pair? out)
340 (reverse out))))
341
342 (define fudlist
343 '())
344
345 (define-macro (fudify f)
0be7090f »
2008-08-03 (gimp-snippets): drop radio snippet, as the param
346 ;; "Instruct a function for debugging;
497da025 »
2008-08-03 * gimp-mode.el (gimp-comint-filter): add prettification to output
347
0be7090f »
2008-08-03 (gimp-snippets): drop radio snippet, as the param
348 ;; Any subsequent call to function F will cause fud-breaks to occur at
349 ;; any immediate sublevel of F. Remove the instruction with (unfud
350 ;; FUNTION).
497da025 »
2008-08-03 * gimp-mode.el (gimp-comint-filter): add prettification to output
351
0be7090f »
2008-08-03 (gimp-snippets): drop radio snippet, as the param
352 ;; Any redefinition will uninstruct the function. This will give you the
353 ;; error `Function is already fudified' if after that you want to fudify
354 ;; it again. Client agents can to some intercepting to make this
355 ;; automatic."
497da025 »
2008-08-03 * gimp-mode.el (gimp-comint-filter): add prettification to output
356 (let
357 ((name f))
358 `(begin
359 (if
360 (assq ',name fudlist)
361 (error
362 (string-append
363 (symbol->string ',f)
364 " is already fudified")))
365 (set! fudlist
366 (cons
367 (list ',name
368 (get-closure-code ,f))
369 fudlist))
370 (define ,f
371 (eval
372 (fud-instruct-1
373 (get-closure-code ,f)))))))
374
0be7090f »
2008-08-03 (gimp-snippets): drop radio snippet, as the param
375
Something went wrong with that request. Please try again.