Changeset 14311 in project


Ignore:
Timestamp:
04/20/09 05:56:33 (11 years ago)
Author:
Alex Shinn
Message:

autoload for chicken 4

Location:
release/4/autoload
Files:
2 edited
1 copied

Legend:

Unmodified
Added
Removed
  • release/4/autoload/autoload.scm

    r6665 r14311  
    11;;;; autoload.scm -- load modules lazily
    22;;
    3 ;; Copyright (c) 2005 Alex Shinn
     3;; Copyright (c) 2005-2009 Alex Shinn
    44;; All rights reserved.
    55;;
     
    4040;; (autoload md5 (md5:digest #f scheme-md5:digest))
    4141
    42 (define-macro (autoload unit . procs)
    43   (cons 'begin
     42(require-library lolevel)
     43
     44(module autoload
     45  ((autoload global-ref))
     46
     47(import scheme chicken lolevel)
     48
     49(define-syntax autoload
     50  (er-macro-transformer
     51   (lambda (expr rename compare)
     52     (let ((unit (cadr expr))
     53           (procs (cddr expr)))
     54       (cons
     55        (rename 'begin)
    4456        (map
    4557         (lambda (x)
    46            (let-optionals* (if (pair? x) x (list x))
    47                ((name #f) (alias #f) (default #f))
    48              (unless alias (set! alias name))
     58           (let* ((x (if (pair? x) x (list x)))
     59                  (name (car x))
     60                  (full-name
     61                   (string->symbol
     62                    (string-append (symbol->string unit) "#"
     63                                   (symbol->string name))))
     64                  (alias (or (and (pair? (cdr x)) (cadr x)) name))
     65                  (default (and (pair? (cdr x)) (pair? (cddr x)) (caddr x))))
    4966             (if default
    50                `(define (,alias . args)
    51                   (condition-case
    52                    (begin
    53                      (require ',unit)
    54                      (set! ,alias ,name)
    55                      (apply (eval ',name) args))
    56                    (exn ()
    57                      (set! ,alias ,default)
    58                      (apply (eval ,alias) args))))
    59                `(define (,alias . args)
    60                   (require ',unit)
    61                   (set! ,alias ,name)
    62                   (apply (eval ',name) args)))))
    63          procs)))
     67                 `(,(rename 'define) (,alias . ,(rename 'args))
     68                    (,(rename 'condition-case)
     69                     (,(rename 'begin)
     70                       (,(rename 'require) ',unit)
     71                       (,(rename 'let) ((,(rename 'tmp)
     72                                         (,(rename 'global-ref) ',full-name)))
     73                         (,(rename 'set!) ,alias ,(rename 'tmp))
     74                         (,(rename 'apply)
     75                          ,(rename 'tmp)
     76                          ,(rename 'args))))
     77                     (exn ()
     78                          (,(rename 'let) ((,(rename 'tmp) ,default))
     79                           (,(rename 'set!) ,alias ,(rename 'tmp))
     80                           (,(rename 'apply)
     81                            ,(rename 'tmp)
     82                            ,(rename 'args))))))
     83                 `(,(rename 'define) (,alias . ,(rename 'args))
     84                   (,(rename 'require) ',unit)
     85                   (,(rename 'let) ((,(rename 'tmp)
     86                                     (,(rename 'global-ref) ',full-name)))
     87                    (,(rename 'set!) ,alias ,(rename 'tmp))
     88                    (,(rename 'apply)
     89                     ,(rename 'tmp)
     90                     ,(rename 'args)))))))
     91             procs))))))
    6492
     93)
  • release/4/autoload/autoload.setup

    r6665 r14311  
     1
     2(compile -s -O2 -j autoload autoload.scm)
     3(compile -s -O2 autoload.import.scm)
     4
    15(install-extension
    2  'autoload '("autoload.scm")
    3  '((version 1.1)
    4    (syntax)) )
     6 'autoload '("autoload.so" "autoload.import.so")
     7 '((version 1.2) (syntax)))
Note: See TracChangeset for help on using the changeset viewer.