source: project/release/5/expand-full/tags/2.1.0/expand-full.scm @ 39011

Last change on this file since 39011 was 39011, checked in by Kon Lovett, 7 weeks ago

rel 2.1.0

File size: 2.1 KB
Line 
1;;;; expand-full.scm  -*- Scheme -*-
2;;;; Kon Lovett, Sep '19
3;;;; Kon Lovett, Jul '18
4;;;; Kon Lovett, Apr '09
5
6;; Issues
7;;
8;; - depth vs breadth
9
10(module expand-full
11
12(;export
13  ;
14  expandable?
15  expand-if
16  expand-depth depth
17  expand-breadth breadth
18  ;
19  expand*
20  pretty-print-expand* ppexpand*)
21
22(import scheme)
23(import (chicken base))
24(import (chicken type))
25(import (chicken syntax))
26(import (only (chicken platform) feature?))
27#; ;NOTE since could be used in a compiled context cannot require a "non-existing" module
28(import (only (chicken csi) toplevel-command))
29(import (only (chicken pretty-print) pretty-print))
30(import (only (srfi 1) proper-list?))
31(import (only vector-lib vector-map))
32
33;;
34
35(define (safe-list-map func form)
36  (let ((1st (func (car form))))
37    (if (null? (cdr form))
38      1st
39      (cons 1st (func (cdr form)))) ) )
40
41(define (across func form)
42  (cond
43    ((vector? form) (vector-map (lambda (_ x) (func x)) form))
44    ((pair? form)   (safe-list-map func form))
45    (else           form)) )
46
47(define (down stpr form expanded)
48  (let loop ((form form) (expanded expanded))
49    (if (equal? form expanded)
50      form
51      (loop expanded (across stpr expanded)) ) ) )
52
53(define (breadth xpdr form) (down (cut breadth xpdr <>) form (xpdr (across xpdr form))))
54
55(define (depth xpdr form) (down (cut depth xpdr <>) form (xpdr form)))
56
57;;
58
59(define (expandable? obj) (or (atom? obj) (proper-list? obj)))
60
61(define (expand-if form . args) (if (expandable? form) (apply expand form args) form))
62
63(define (expand-breadth form . args) (breadth (cut apply expand <> args) form))
64(define (expand-depth form . args) (depth (cut apply expand-if <> args) form))
65
66(define expand* expand-breadth)
67
68;;
69
70(define (pretty-print-expand* form . args)
71  (pretty-print (strip-syntax (apply expand* form args)))
72  (void) )
73
74(define ppexpand* pretty-print-expand*)
75
76;;;
77
78(when (feature? 'csi)
79  (chicken.csi#toplevel-command 'x*
80    ;FIXME need apropos like csi argument handler
81    (lambda () (ppexpand* (read)))
82    ",x* EXP           Pretty print, almost fully, expanded expression EXP") )
83
84) ;module expand-full
Note: See TracBrowser for help on using the repository browser.