Changeset 39010 in project


Ignore:
Timestamp:
09/10/20 01:13:59 (2 weeks ago)
Author:
Kon Lovett
Message:

better names, macros at runtime for test

Location:
release/5/expand-full/trunk
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • release/5/expand-full/trunk/expand-full.scm

    r39009 r39010  
    66;; Issues
    77;;
    8 ;; - depth vs breadth is wrong; both are depth
     8;; - depth vs breadth
    99
    1010(module expand-full
     
    1414  expandable?
    1515  expand-if
    16   expand-depth expand-depth* expand*
    17   expand-breadth expand-breadth*
     16  expand-depth depth
     17  expand-breadth breadth
    1818  ;
     19  expand*
    1920  pretty-print-expand* ppexpand*)
    2021
     
    3233;;
    3334
    34 (define (walk* func form)
     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)
    3542  (cond
    36     ((vector? form)      (vector-map (lambda (_ x) (func x)) form))
    37     ;((atom? form)        form)
    38     ;#; ;NOTE needed 4 "depth" or pre-order
    39     ((proper-list? form) (map (lambda (x) (func x)) form))
    40     ((pair? form)        (cons (func (car form)) (func (cdr form))))
    41     (else                form)) )
     43    ((vector? form) (vector-map (lambda (_ x) (func x)) form))
     44    ((pair? form)   (safe-list-map func form))
     45    (else           form)) )
    4246
    43 (define (expand-depth* xpdr form)
    44   (define (down x) (expand-depth* xpdr x))
    45   (let* (
    46     (form (walk* down form))
    47     (expanded (xpdr form)) )
     47(define (down stpr form expanded)
     48  (let loop ((form form) (expanded expanded))
    4849    (if (equal? form expanded)
    4950      form
    50       (walk* down expanded) ) ) )
     51      (loop expanded (across stpr expanded)) ) ) )
    5152
    52 (define (expand-breadth* xpdr form)
    53   (define (across x) (expand-breadth* xpdr x))
    54   (let (
    55     (expanded (xpdr form)) )
    56     (if (equal? form expanded)
    57       form
    58       (walk* across expanded) ) ) )
     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)))
    5956
    6057;;
     
    6461(define (expand-if form . args) (if (expandable? form) (apply expand form args) form))
    6562
    66 (define (expand-depth form . args) (expand-depth* (cut apply expand-if <> args) form))
    67 (define (expand-breadth form . args) (expand-breadth* (cut apply expand <> args) form))
     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))
    6865
    69 (define expand* expand-depth)
     66(define expand* expand-breadth)
    7067
    7168;;
  • release/5/expand-full/trunk/tests/run.scm

    r38543 r39010  
    3333  -specialize -optimize-leaf-routines -clustering -lfa2 \
    3434  -no-trace -unsafe \
    35   -strict-types")
     35  -strict-types \
     36  -compile-syntax")
    3637
    3738(define *test-files-rx* (irregex '(: (+ graph) #\- "test" #\. "scm")))
     
    7071;;; Do Test
    7172
     73(set! *csc-options* (string-append *csc-options* " " "-compile-syntax"))
    7274(run-tests)
Note: See TracChangeset for help on using the changeset viewer.