Changeset 8061 in project


Ignore:
Timestamp:
02/02/08 15:56:23 (12 years ago)
Author:
felix winkelmann
Message:

preexpand handles cond-expand

Location:
release/3/modules
Files:
4 edited
1 copied

Legend:

Unmodified
Added
Removed
  • release/3/modules/tags/0.9/modules-base.scm

    r7273 r8061  
    2323  hidden)
    2424
     25(define *debug-modules* (feature? 'debug-modules))
    2526(define *modules* '())
    2627(define context (make-parameter (make-context #f '() '() '())))
     
    109110           m) ) ) )
    110111
     112(define (expand-cond-expand clauses)
     113  (define (check t)
     114    (match t
     115      (('and ts ...) (every check ts))
     116      (('or ts ...) (any check ts))
     117      (('not t) (not (check t)))
     118      ((? symbol? f) (feature? f))
     119      (else (syntax-error 'cond-expand "invalid conditional expression in `cond-expand'" f)) ) )
     120  (let loop ((clauses clauses))
     121    (match clauses
     122      (() (syntax-error 'cond-expand "no matching `cond-expand' clause" clauses))
     123      ((('else . body) . _)
     124       `(begin ,@body) )
     125      (((test . body) . more)
     126       (if (check test)
     127           `(begin ,@body)
     128           (loop more) ) )
     129      (c (syntax-error 'cond-expand "invalid `cond-expand' clause" c)) ) ) )
     130
    111131(define (preexpand body)
    112132  (let ((c (context)))
     
    120140               (context-hidden-set! c (cons (cons name r) (context-hidden c)))
    121141               r) ) ) )
    122     (define expand
    123       (match-lambda
     142    (define (expand form)
     143      (when *debug-modules* (pp `(PREEXPAND: ,form)))
     144      (match form
    124145        (('begin . body)
    125          (map expand body) )
     146         `(begin ,@(map expand body) ) )
    126147        (((and def (or 'define 'define*)) ((? pair? head) . llist) . body)
    127148         (expand `(,def ,head (lambda ,llist ,@body))) )
     
    132153        (('define-values (vars ...) val)
    133154         `(define-values ,(map process vars) ,val))
     155        (('cond-expand clauses ...)
     156         (expand (expand-cond-expand clauses) ) )
    134157        (('include file)
    135158         (let ((f (or (file-exists? (##sys#resolve-include-filename file #t #f))
  • release/3/modules/tags/0.9/modules.setup

    r7273 r8061  
    44 'modules
    55 '("modules.scm" "modules-base.so")
    6  '((version 0.8)
     6 '((version 0.9)
    77   (syntax)
    88   (documentation "modules.html")))
  • release/3/modules/trunk/modules-base.scm

    r7273 r8061  
    2323  hidden)
    2424
     25(define *debug-modules* (feature? 'debug-modules))
    2526(define *modules* '())
    2627(define context (make-parameter (make-context #f '() '() '())))
     
    109110           m) ) ) )
    110111
     112(define (expand-cond-expand clauses)
     113  (define (check t)
     114    (match t
     115      (('and ts ...) (every check ts))
     116      (('or ts ...) (any check ts))
     117      (('not t) (not (check t)))
     118      ((? symbol? f) (feature? f))
     119      (else (syntax-error 'cond-expand "invalid conditional expression in `cond-expand'" f)) ) )
     120  (let loop ((clauses clauses))
     121    (match clauses
     122      (() (syntax-error 'cond-expand "no matching `cond-expand' clause" clauses))
     123      ((('else . body) . _)
     124       `(begin ,@body) )
     125      (((test . body) . more)
     126       (if (check test)
     127           `(begin ,@body)
     128           (loop more) ) )
     129      (c (syntax-error 'cond-expand "invalid `cond-expand' clause" c)) ) ) )
     130
    111131(define (preexpand body)
    112132  (let ((c (context)))
     
    120140               (context-hidden-set! c (cons (cons name r) (context-hidden c)))
    121141               r) ) ) )
    122     (define expand
    123       (match-lambda
     142    (define (expand form)
     143      (when *debug-modules* (pp `(PREEXPAND: ,form)))
     144      (match form
    124145        (('begin . body)
    125          (map expand body) )
     146         `(begin ,@(map expand body) ) )
    126147        (((and def (or 'define 'define*)) ((? pair? head) . llist) . body)
    127148         (expand `(,def ,head (lambda ,llist ,@body))) )
     
    132153        (('define-values (vars ...) val)
    133154         `(define-values ,(map process vars) ,val))
     155        (('cond-expand clauses ...)
     156         (expand (expand-cond-expand clauses) ) )
    134157        (('include file)
    135158         (let ((f (or (file-exists? (##sys#resolve-include-filename file #t #f))
  • release/3/modules/trunk/modules.setup

    r7273 r8061  
    44 'modules
    55 '("modules.scm" "modules-base.so")
    6  '((version 0.8)
     6 '((version 0.9)
    77   (syntax)
    88   (documentation "modules.html")))
Note: See TracChangeset for help on using the changeset viewer.