Changeset 39009 in project


Ignore:
Timestamp:
09/09/20 21:20:06 (2 weeks ago)
Author:
Kon Lovett
Message:

chicken.csi is missing, simplify

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

Legend:

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

    r38543 r39009  
    44;;;; Kon Lovett, Apr '09
    55
    6 ;;;
     6;; Issues
     7;;
     8;; - depth vs breadth is wrong; both are depth
    79
    810(module expand-full
    911
    1012(;export
     13  ;
    1114  expandable?
    1215  expand-if
    13   expand-depth*
    14   expand-depth**
    15   expand-breadth*
    16   expand*
     16  expand-depth expand-depth* expand*
     17  expand-breadth expand-breadth*
     18  ;
    1719  pretty-print-expand* ppexpand*)
    1820
     
    2224(import (chicken syntax))
    2325(import (only (chicken platform) feature?))
    24 ;unexported bug
     26#; ;NOTE since could be used in a compiled context cannot require a "non-existing" module
    2527(import (only (chicken csi) toplevel-command))
    2628(import (only (chicken pretty-print) pretty-print))
    27 (import (only (srfi 1) proper-list? map!))
     29(import (only (srfi 1) proper-list?))
    2830(import (only vector-lib vector-map))
    2931
    3032;;
    3133
    32 (define (expandable? obj)
    33   (or
    34     (atom? obj)
    35     (proper-list? obj) ) )
     34(define (walk* func form)
     35  (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)) )
    3642
    37 (define (expand-if form . args)
    38   (if (expandable? form)
    39     (apply expand form args)
    40     form ) )
    41 
    42 (define (walk* func obj)
    43   (cond
    44     ((vector? obj)
    45       (vector-map (lambda (_ x) (func x)) obj) )
    46     ((atom? obj)
    47       obj )
    48     ;NOTE ???
    49     ((proper-list? obj)
    50       (map func obj) )
    51     ((pair? obj)
    52       (cons (func (car obj)) (func (cdr obj))) ) ) )
    53 
    54 (define (expand-depth** form . args)
     43(define (expand-depth* xpdr form)
     44  (define (down x) (expand-depth* xpdr x))
    5545  (let* (
    56     (form (walk* expand-depth** form))
    57     (expanded (apply expand form args)) )
     46    (form (walk* down form))
     47    (expanded (xpdr form)) )
    5848    (if (equal? form expanded)
    5949      form
    60       (walk* expand-depth** expanded) ) ) )
     50      (walk* down expanded) ) ) )
    6151
    62 (define (expand-depth* form . args)
    63   (let* (
    64     (form (walk* expand-depth* form))
    65     (expanded (apply expand-if form args)) )
     52(define (expand-breadth* xpdr form)
     53  (define (across x) (expand-breadth* xpdr x))
     54  (let (
     55    (expanded (xpdr form)) )
    6656    (if (equal? form expanded)
    6757      form
    68       (walk* expand-depth* expanded) ) ) )
     58      (walk* across expanded) ) ) )
    6959
    70 (define (expand-breadth* form . args)
    71   (let (
    72     (expanded (apply expand form args)) )
    73     (if (equal? form expanded)
    74       form
    75       (walk* expand-breadth* expanded) ) ) )
     60;;
    7661
    77 (define expand* expand-depth*)
     62(define (expandable? obj) (or (atom? obj) (proper-list? obj)))
     63
     64(define (expand-if form . args) (if (expandable? form) (apply expand form args) form))
     65
     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))
     68
     69(define expand* expand-depth)
    7870
    7971;;
  • release/5/expand-full/trunk/tests/expand-full-test.scm

    r38440 r39009  
    8989                (error (##core#quote stream-match) "pattern failure")))))))))
    9090
    91 (cond-expand
    92   (csi
    93     (print) (print "stream s-expr expand")
    94     (ppexpand* expd-test-data-1)
    95     ;(test "stream s-expr expand" expd-test-result-1 (strip-gensym (expand* expd-test-data-1)))
     91(test-group "ppexpand*"
     92  (print) (print "stream s-expr expand")
     93  (ppexpand* expd-test-data-1)
     94  ;(test "stream s-expr expand" expd-test-result-1 (strip-gensym (expand* expd-test-data-1)))
    9695
    97     (print) (print "'(and a b) expand")
    98     (ppexpand* '(and a b))
    99     ;(test '(##core#if a b #f) (strip-gensym (expand* '(and a b))))
    100   )
    101   (else)
     96  (print) (print "'(and a b) expand")
     97  (ppexpand* '(and a b))
     98  ;(test '(##core#if a b #f) (strip-gensym (expand* '(and a b))))
    10299)
    103100
Note: See TracChangeset for help on using the changeset viewer.