source: project/release/5/expand-full/trunk/expand-full.scm @ 36239

Last change on this file since 36239 was 36239, checked in by Kon Lovett, 15 months ago

fix expdr, rel 2.0.2

File size: 1.4 KB
Line 
1;;;; expand-full.scm  -*- Scheme -*-
2;;;; Kon Lovett, Jul '18
3;;;; Kon Lovett, Apr '09
4
5;;;
6
7(module expand-full
8
9(;export
10  expand*
11  pretty-print-expand* ppexpand*)
12
13(import scheme
14  (chicken base)
15  (chicken type)
16  (chicken syntax)
17  (only (chicken platform) feature?)
18  ;(only (chicken csi) toplevel-command)
19  (only (chicken pretty-print) pretty-print)
20  (only (srfi 1) proper-list? map!)
21  (only vector-lib vector-map))
22
23;;
24
25(: expand (* #!rest --> *))
26;
27(define (expand* form . args)
28  (let expand-loop ((form form))
29    (let ((expanded (apply expand form args)))
30      ;
31      (define (walk obj)
32        (cond
33          ((null? obj)
34            '() )
35          ((proper-list? obj)
36            (map expand-loop obj) )
37          ((pair? obj)
38            (cons (expand-loop (car obj)) (expand-loop (cdr obj))) )
39          ((vector? obj)
40            (vector-map (lambda (_ x) (expand-loop x)) obj) )
41          (else
42            obj ) ) )
43      ;
44      (if (equal? form expanded)
45        form
46        (walk expanded) ) ) ) )
47
48;;
49
50(: pretty-print-expand* (* #!rest --> *))
51;
52(define (pretty-print-expand* form . args)
53  (pretty-print (strip-syntax (apply expand* form args)))
54  (void) )
55
56(define ppexpand* pretty-print-expand*)
57
58;;;
59
60(when (feature? 'csi)
61  (chicken.csi#toplevel-command 'x*
62    ;FIXME need apropos like csi argument handler
63    (lambda () (ppexpand* (read)))
64    ",x* EXP           Pretty print, almost fully, expanded expression EXP") )
65
66) ;module expand-full
Note: See TracBrowser for help on using the repository browser.