Changeset 38252 in project


Ignore:
Timestamp:
03/14/20 18:44:35 (2 weeks ago)
Author:
Kon Lovett
Message:

breadth v depth

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

Legend:

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

    r36239 r38252  
    33
    44((synopsis "Full macro expansion")
    5  (version "2.0.2")
     5 (version "2.1.0")
    66 (category misc)
    77 (author "[[kon lovett]]")
     
    1515    #;(inline-file)
    1616    (types-file)
    17     (csc-options "-O3" "-d1") ) ) )
     17    (csc-options "-O3" "-d1" "-local" "-no-procedure-checks") ) ) )
  • release/5/expand-full/trunk/expand-full.scm

    r36239 r38252  
    11;;;; expand-full.scm  -*- Scheme -*-
     2;;;; Kon Lovett, Sep '19
    23;;;; Kon Lovett, Jul '18
    34;;;; Kon Lovett, Apr '09
     
    89
    910(;export
     11  expandable?
     12  expand-if
     13  expand-depth*
     14  expand-depth**
     15  expand-breadth*
    1016  expand*
    1117  pretty-print-expand* ppexpand*)
     
    1622  (chicken syntax)
    1723  (only (chicken platform) feature?)
    18   ;(only (chicken csi) toplevel-command)
     24  ;(only (chicken csi) toplevel-command) ;unexported bug
    1925  (only (chicken pretty-print) pretty-print)
    2026  (only (srfi 1) proper-list? map!)
     
    2329;;
    2430
    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) ) ) ) )
     31(define (expandable? obj)
     32  (or
     33    (atom? obj)
     34    (proper-list? obj) ) )
     35
     36(define (expand-if form . args)
     37  (if (expandable? form)
     38    (apply expand form args)
     39    form ) )
     40
     41(define (walk* func obj)
     42  (cond
     43    ((vector? obj)
     44      (vector-map (lambda (_ x) (func x)) obj) )
     45    ((atom? obj)
     46      obj )
     47    ;NOTE ???
     48    ((proper-list? obj)
     49      (map func obj) )
     50    ((pair? obj)
     51      (cons (func (car obj)) (func (cdr obj))) ) ) )
     52
     53(define (expand-depth** form . args)
     54  (let* (
     55    (form (walk* expand-depth** form))
     56    (expanded (apply expand form args)) )
     57    (if (equal? form expanded)
     58      form
     59      (walk* expand-depth** expanded) ) ) )
     60
     61(define (expand-depth* form . args)
     62  (let* (
     63    (form (walk* expand-depth* form))
     64    (expanded (apply expand-if form args)) )
     65    (if (equal? form expanded)
     66      form
     67      (walk* expand-depth* expanded) ) ) )
     68
     69(define (expand-breadth* form . args)
     70  (let (
     71    (expanded (apply expand form args)) )
     72    (if (equal? form expanded)
     73      form
     74      (walk* expand-breadth* expanded) ) ) )
     75
     76(define expand* expand-depth*)
    4777
    4878;;
    4979
    50 (: pretty-print-expand* (* #!rest --> *))
    51 ;
    5280(define (pretty-print-expand* form . args)
    5381  (pretty-print (strip-syntax (apply expand* form args)))
Note: See TracChangeset for help on using the changeset viewer.