Changeset 36239 in project


Ignore:
Timestamp:
08/12/18 23:58:33 (4 months ago)
Author:
kon
Message:

fix expdr, rel 2.0.2

Location:
release/5/expand-full
Files:
4 edited
1 copied

Legend:

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

    r35967 r36239  
    33
    44((synopsis "Full macro expansion")
    5  (version "2.0.1")
     5 (version "2.0.2")
    66 (category misc)
    77 (author "[[kon lovett]]")
  • release/5/expand-full/tags/2.0.2/expand-full.scm

    r35936 r36239  
    1 ;;;; expand-full.scm
     1;;;; expand-full.scm  -*- Scheme -*-
     2;;;; Kon Lovett, Jul '18
    23;;;; Kon Lovett, Apr '09
    34
     
    1011  pretty-print-expand* ppexpand*)
    1112
    12 (import
    13   scheme
     13(import scheme
    1414  (chicken base)
    1515  (chicken type)
    1616  (chicken syntax)
    1717  (only (chicken platform) feature?)
    18   (only (chicken csi) toplevel-command)
     18  ;(only (chicken csi) toplevel-command)
    1919  (only (chicken pretty-print) pretty-print)
    2020  (only (srfi 1) proper-list? map!)
     
    2323;;
    2424
    25 (: expand (* #!optional * --> *))
     25(: expand (* #!rest --> *))
    2626;
    27 (define (expand* form #!optional se)
     27(define (expand* form . args)
    2828  (let expand-loop ((form form))
    29     (let (
    30       (expanded
     29    (let ((expanded (apply expand form args)))
     30      ;
     31      (define (walk obj)
    3132        (cond
    32           ((null? form)
     33          ((null? obj)
    3334            '() )
    34           ((proper-list? form)
    35             (let ((expanded (expand form se)))
    36               (if (not (proper-list? expanded))
    37                 expanded
    38                 (map! expand-loop expanded) ) ) )
    39           ((pair? form)
    40             (cons (expand-loop (car form)) (expand-loop (cdr form))) )
    41           ((vector? form)
    42             (vector-map (lambda (_ x) (expand-loop x)) form) )
     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) )
    4341          (else
    44             form ) ) ) )
     42            obj ) ) )
     43      ;
    4544      (if (equal? form expanded)
    4645        form
    47         (expand-loop expanded) ) ) ) )
    48 
    49 #; ;WTF
    50 (define (expand* form #!optional se going-up?)
    51   ;
    52   (: protected? (* --> boolean))
    53   ;
    54   (define (protected? obj)
    55     (or (null? obj) (atom? obj) (not (proper-list? obj))) )
    56 
    57   (: protected-expand (* #!optional * --> *))
    58   ;
    59   (define (protected-expand form #!optional se)
    60     (if (protected? form)
    61       form
    62       (expand form se)) )
    63 
    64   (: protected-equal=? (* * --> boolean))
    65   ;
    66   (define (protected-equal=? a b)
    67     (or
    68       (and (not (number? a)) (protected? a))
    69       (and (not (number? b)) (protected? b))
    70       (equal=? a b)) )
    71   ;
    72   (let expand*-loop ((form form))
    73     ;
    74     (define (seq-expand form)
    75       (cond
    76         ((pair? form)
    77           (cons (expand*-loop (car form)) (expand*-loop (cdr form))) )
    78         ((list? form)
    79           (map expand*-loop form) )
    80         ((vector? form)
    81           (vector-map (lambda (_ x) (expand*-loop x)) form) )
    82         (else
    83           form ) ) )
    84     ;
    85     ;(define local-protected-expand (o strip-syntax (cut protected-expand <> se)))
    86     (define local-protected-expand (cut protected-expand <> se))
    87     ;
    88     (define bottom-up (o local-protected-expand seq-expand))
    89     (define top-down (o seq-expand local-protected-expand))
    90     (define go-direction (if going-up? bottom-up top-down))
    91     ;
    92     (let ((expanded (go-direction form)))
    93       (if (protected-equal=? form expanded)
    94         form
    95         (expand*-loop expanded) ) ) ) )
     46        (walk expanded) ) ) ) )
    9647
    9748;;
    9849
    99 (: pretty-print-expand* (* #!optional * --> *))
     50(: pretty-print-expand* (* #!rest --> *))
    10051;
    101 (define (pretty-print-expand* form #!optional se)
    102   (pretty-print (strip-syntax (expand* form se)))
     52(define (pretty-print-expand* form . args)
     53  (pretty-print (strip-syntax (apply expand* form args)))
    10354  (void) )
    10455
    105 (: ppexpand* (* #!optional * --> *))
    106 ;
    10756(define ppexpand* pretty-print-expand*)
    10857
     
    11059
    11160(when (feature? 'csi)
    112   (toplevel-command 'x*
     61  (chicken.csi#toplevel-command 'x*
    11362    ;FIXME need apropos like csi argument handler
    11463    (lambda () (ppexpand* (read)))
  • release/5/expand-full/trunk/expand-full.egg

    r35967 r36239  
    33
    44((synopsis "Full macro expansion")
    5  (version "2.0.1")
     5 (version "2.0.2")
    66 (category misc)
    77 (author "[[kon lovett]]")
  • release/5/expand-full/trunk/expand-full.scm

    r35936 r36239  
    1 ;;;; expand-full.scm
     1;;;; expand-full.scm  -*- Scheme -*-
     2;;;; Kon Lovett, Jul '18
    23;;;; Kon Lovett, Apr '09
    34
     
    1011  pretty-print-expand* ppexpand*)
    1112
    12 (import
    13   scheme
     13(import scheme
    1414  (chicken base)
    1515  (chicken type)
    1616  (chicken syntax)
    1717  (only (chicken platform) feature?)
    18   (only (chicken csi) toplevel-command)
     18  ;(only (chicken csi) toplevel-command)
    1919  (only (chicken pretty-print) pretty-print)
    2020  (only (srfi 1) proper-list? map!)
     
    2323;;
    2424
    25 (: expand (* #!optional * --> *))
     25(: expand (* #!rest --> *))
    2626;
    27 (define (expand* form #!optional se)
     27(define (expand* form . args)
    2828  (let expand-loop ((form form))
    29     (let (
    30       (expanded
     29    (let ((expanded (apply expand form args)))
     30      ;
     31      (define (walk obj)
    3132        (cond
    32           ((null? form)
     33          ((null? obj)
    3334            '() )
    34           ((proper-list? form)
    35             (let ((expanded (expand form se)))
    36               (if (not (proper-list? expanded))
    37                 expanded
    38                 (map! expand-loop expanded) ) ) )
    39           ((pair? form)
    40             (cons (expand-loop (car form)) (expand-loop (cdr form))) )
    41           ((vector? form)
    42             (vector-map (lambda (_ x) (expand-loop x)) form) )
     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) )
    4341          (else
    44             form ) ) ) )
     42            obj ) ) )
     43      ;
    4544      (if (equal? form expanded)
    4645        form
    47         (expand-loop expanded) ) ) ) )
    48 
    49 #; ;WTF
    50 (define (expand* form #!optional se going-up?)
    51   ;
    52   (: protected? (* --> boolean))
    53   ;
    54   (define (protected? obj)
    55     (or (null? obj) (atom? obj) (not (proper-list? obj))) )
    56 
    57   (: protected-expand (* #!optional * --> *))
    58   ;
    59   (define (protected-expand form #!optional se)
    60     (if (protected? form)
    61       form
    62       (expand form se)) )
    63 
    64   (: protected-equal=? (* * --> boolean))
    65   ;
    66   (define (protected-equal=? a b)
    67     (or
    68       (and (not (number? a)) (protected? a))
    69       (and (not (number? b)) (protected? b))
    70       (equal=? a b)) )
    71   ;
    72   (let expand*-loop ((form form))
    73     ;
    74     (define (seq-expand form)
    75       (cond
    76         ((pair? form)
    77           (cons (expand*-loop (car form)) (expand*-loop (cdr form))) )
    78         ((list? form)
    79           (map expand*-loop form) )
    80         ((vector? form)
    81           (vector-map (lambda (_ x) (expand*-loop x)) form) )
    82         (else
    83           form ) ) )
    84     ;
    85     ;(define local-protected-expand (o strip-syntax (cut protected-expand <> se)))
    86     (define local-protected-expand (cut protected-expand <> se))
    87     ;
    88     (define bottom-up (o local-protected-expand seq-expand))
    89     (define top-down (o seq-expand local-protected-expand))
    90     (define go-direction (if going-up? bottom-up top-down))
    91     ;
    92     (let ((expanded (go-direction form)))
    93       (if (protected-equal=? form expanded)
    94         form
    95         (expand*-loop expanded) ) ) ) )
     46        (walk expanded) ) ) ) )
    9647
    9748;;
    9849
    99 (: pretty-print-expand* (* #!optional * --> *))
     50(: pretty-print-expand* (* #!rest --> *))
    10051;
    101 (define (pretty-print-expand* form #!optional se)
    102   (pretty-print (strip-syntax (expand* form se)))
     52(define (pretty-print-expand* form . args)
     53  (pretty-print (strip-syntax (apply expand* form args)))
    10354  (void) )
    10455
    105 (: ppexpand* (* #!optional * --> *))
    106 ;
    10756(define ppexpand* pretty-print-expand*)
    10857
     
    11059
    11160(when (feature? 'csi)
    112   (toplevel-command 'x*
     61  (chicken.csi#toplevel-command 'x*
    11362    ;FIXME need apropos like csi argument handler
    11463    (lambda () (ppexpand* (read)))
Note: See TracChangeset for help on using the changeset viewer.