Changeset 39062 in project

Timestamp:

10/19/20 21:58:28 (4 months ago)

Author:

Kon Lovett

Message:

comment simpler form

Location:

release/5/expand-full/trunk

Files:

• expand-full.egg (modified) (1 diff)
• expand-full.scm (modified) (3 diffs)

release/5/expand-full/trunk/expand-full.egg

@@ -7 +7 @@
  (author "[[kon lovett]]")
  (license "BSD")
- (dependencies srfi-1 vector-lib)
+ (dependencies srfi-1)
  (test-dependencies test)
  (components

release/5/expand-full/trunk/expand-full.scm

@@ -1 @@
-;;;; expand-full.scm  -*- Scheme -*-
+;;;; expand-full.scm  -*- scheme -*-
+;;;; Kon Lovett, Oct '20
 ;;;; Kon Lovett, Sep '19
 ;;;; Kon Lovett, Jul '18
 ;;;; Kon Lovett, Apr '09
 
-;; Issues
-;;
-;; - depth vs breadth
-
 (module expand-full
 
 (;export
-  ;
-  expandable?
-  expand-if
-  expand-depth depth
-  expand-breadth breadth
-  ;
   expand*
   pretty-print-expand* ppexpand*)
@@ -27 +18 @@
 (import (only (chicken pretty-print) pretty-print))
 (import (only (srfi 1) proper-list?))
-(import (only vector-lib vector-map))
 
 ;;
 
-(define (safe-list-map func form)
-  (let ((1st (func (car form))))
-    (if (null? (cdr form))
-      1st
-      (cons 1st (func (cdr form)))) ) )
-
-(define (across func form)
-  (cond
-    ((vector? form)
-      (vector-map (lambda (_ x) (func x)) form))
-    ((pair? form)
-      (print "across " form)
-      (if (or (eq? 'quote (car form)) (eq? '##core#quote (car form)))
-        form
-        (safe-list-map func form)))
-    (else
-      form)) )
-
-(define (down stpr form expanded)
-  (let loop ((form form) (expanded expanded))
-    (if (equal? form expanded)
-      form
-      (loop expanded (across stpr expanded)) ) ) )
-
-(define (breadth xpdr form) (down (cut breadth xpdr <>) form (xpdr (across xpdr form))))
-
-(define (depth xpdr form) (down (cut depth xpdr <>) form (xpdr form)))
+(define (expand-form xpdr form)
+  (define (quote? x) (or (eq? 'quote x) (eq? '##core#quote x)))
+  ;expand 1st, then recurse
+  (let ((expd (xpdr form)))
+    (cond
+      ;empty form
+      ((null? expd)
+        expd )
+      ;list form
+      ((proper-list? expd)
+        ;skip quoted form (skips '(1 2 ...) but ...)
+        (if (quote? (car expd))
+          expd
+          (map (cut expand-form xpdr <>) expd) ) )
+      ;improper list form
+      ((pair? expd)
+        (cons (expand-form xpdr (car expd)) (expand-form xpdr (cdr expd))) )
+      ;atom
+      (else
+        expd ) ) ) )
 
 ;;
@@ -65 +48 @@
 (define (expand-if form . args) (if (expandable? form) (apply expand form args) form))
 
-(define (expand-breadth form . args) (breadth (cut apply expand <> args) form))
-(define (expand-depth form . args) (depth (cut apply expand-if <> args) form))
-
-(define expand* expand-breadth)
+(define (expand* form . args) (expand-form (cut apply expand-if <> args) form))
 
 ;;
 
 (define (pretty-print-expand* form . args)
+  ;FIXME why strip-syntax on result & not input form?
   (pretty-print (strip-syntax (apply expand* form args)))
   (void) )