Changeset 14348 in project


Ignore:
Timestamp:
04/22/09 17:49:14 (11 years ago)
Author:
Alex Shinn
Message:

make for chicken 4

Location:
release/4/make
Files:
5 copied

Legend:

Unmodified
Added
Removed
  • release/4/make/make.meta

    r14347 r14348  
    77 (doc-from-wiki)
    88 (author "PLT, adapted to Chicken by [[felix winkelmann]]")
    9  (files "make.setup" "make.scm" "make-support.scm" "make.html"))
     9 (files "make.setup" "make.scm" "make.html"))
  • release/4/make/make.scm

    r14347 r14348  
    1 ;;;; syntax.scm
    2 
    3 
    4 (define-macro (make spec . argv)
    5   (let ([make (lambda (spec argv)
    6                 (let ([form-error (lambda (s . p) (apply error s spec p))])
    7                   (and (or (list? spec) (form-error "illegal specification (not a sequence)"))
    8                        (or (pair? spec) (form-error "empty specification"))
    9                        (andmap
    10                         (lambda (line)
    11                           (and (or (and (list? line) (>= (length line) 2))
    12                                    (form-error "clause does not have at least 2 parts" line))
    13                                (let ([name (car line)])
    14                                  (or (list? (cadr line))
    15                                      (make:line-error "second part of clause is not a sequence" (cadr line))))))
    16                         spec))
    17                   `(make/proc (list ,@(map (lambda (line)
    18                                              `(list ,(car line)
    19                                                     (list ,@(cadr line))
    20                                                     ,@(let ([l (cddr line)])
    21                                                         (if (null? l)
    22                                                             '()
    23                                                             `((lambda ()
    24                                                                 ,@l))))))
    25                                            spec))
    26                               ,(if (vector? argv) `',argv (car argv)))))])
    27     (if (pair? argv)
    28         (make spec argv)
    29         (make spec '#())) ) )
     1;;;; make.scm - PLT's `make' macro for CHICKEN - felix
     2
     3#|
     4> (make ((target (depend ...) command ...) ...) argv)
     5
     6expands to
     7
     8  (make/proc
     9    (list (list target (list depend ...) (lambda () command ...)) ...)
     10    argv)
     11
     12> (make/proc spec argv) performs a make according to `spec' and using
     13`argv' as command-line arguments selecting one or more targets.
     14`argv' can either be a string or a vector of strings.
     15
     16`spec' is a MAKE-SPEC:
     17
     18  MAKE-SPEC = (list-of MAKE-LINE)
     19  MAKE-LINE = (list TARGET (list-of DEPEND-STRING) COMMAND-THUNK)
     20  TARGET = (union string (list-of string)) ; either a string or a list of strings
     21  DEPEND-STRING = string
     22  COMMAND-THUNK = (-> void)
     23
     24To make a target, make/proc is first called on each of the target's
     25dependencies. If a target is not in the spec and it exists, then the
     26target is considered made. If a target is older than any of its
     27dependencies, the corresponding COMMAND-THUNK is invoked. The
     28COMMAND-THUNK is optional; a MAKE-LINE without a COMMAND-THUNK is
     29useful as a target for making a number of other targets (the
     30dependencies).
     31
     32Parameters:
     33
     34> (make-print-checking [on?]) - If #f, make only prints when it is
     35making a target. Otherwise, it prints when it is checking the
     36dependancies of a target. Defaultly #t.
     37
     38> (make-print-dep-no-line [on?]) - If #f, make only prints "checking..."
     39lines for dependancies that have a corresponding make line.  Defaultly
     40#f.
     41
     42> (make-print-reasons [on?]) If #t, make prints the reason for each
     43dependancy that fires. Defaultly #t.
     44|#
     45
     46(require-library srfi-1 posix)
     47
     48(module make
     49  ((make make/proc))
     50 
     51(import scheme chicken extras posix srfi-1)
     52
     53(define make-print-checking (make-parameter #f))
     54(define make-print-dep-no-line (make-parameter #f))
     55(define make-print-reasons (make-parameter #f))
     56
     57(define (make:find-matching-line str spec)
     58  (let ((match? (lambda (s) (string=? s str))))
     59    (let loop ((lines spec))
     60      (cond
     61       ((null? lines) #f)
     62       (else (let* ((line (car lines))
     63                    (names (if (string? (car line))
     64                               (list (car line))
     65                               (car line))))
     66               (if (any match? names)
     67                   line
     68                   (loop (cdr lines)))))))))
     69
     70(define (make:form-error s p)
     71  (error (sprintf "~a: ~s" s p)))
     72(define (make:line-error s p n)
     73  (error (sprintf "~a: ~s for line: ~a" s p n)))
     74
     75(define (make:check-spec spec)
     76  (and
     77   (or (list? spec) (make:form-error "specification is not a list" spec))
     78   (or (pair? spec) (make:form-error "specification is an empty list" spec))
     79   (every
     80    (lambda (line)
     81      (and
     82       (or (and (list? line) (<= 2 (length line) 3))
     83           (make:form-error "list is not a list with 2 or 3 parts" line))
     84       (or (or (string? (car line))
     85               (and (list? (car line))
     86                    (every string? (car line))))
     87           (make:form-error "line does not start with a string or list of strings" line))
     88       (let ((name (car line)))
     89         (or (list? (cadr line))
     90             (make:line-error "second part of line is not a list" (cadr line) name)
     91             (every (lambda (dep)
     92                      (or (string? dep)
     93                          (make:form-error "dependency item is not a string" dep)))
     94                    (cadr line)))
     95         (or (null? (cddr line))
     96             (procedure? (caddr line))
     97             (make:line-error "command part of line is not a thunk" (caddr line) name)))))
     98    spec)))
     99
     100(define (make:check-argv argv)
     101  (or (string? argv)
     102      (every
     103       string?
     104       (if (vector? argv) (vector->list argv) argv))
     105      (error "argument is not a string or string vector" argv)))
     106
     107(define (make:make/proc/helper spec argv)
     108  (make:check-spec spec)
     109  (make:check-argv argv)
     110  (letrec ((made '())
     111           (exn? (condition-predicate 'exn))
     112           (exn-message (condition-property-accessor 'exn 'message))
     113           (make-file
     114            (lambda (s indent)
     115              (let ((line (make:find-matching-line s spec))
     116                    (date (and (file-exists? s)
     117                               (file-modification-time s))))
     118
     119                (when (and (make-print-checking)
     120                           (or line
     121                               (make-print-dep-no-line)))
     122                  (printf "make: ~achecking ~a~%" indent s))
     123
     124                (if line
     125                    (let ((deps (cadr line)))
     126                      (for-each (let ((new-indent (string-append " " indent)))
     127                                  (lambda (d) (make-file d new-indent)))
     128                                deps)
     129                      (let ((reason
     130                             (or (not date)
     131                                 (find (lambda (dep)
     132                                         (unless (file-exists? dep)
     133                                           (error (sprintf "dependancy ~a was not made~%" dep)))
     134                                         (and (> (file-modification-time dep) date)
     135                                              dep))
     136                                       deps))))
     137                        (when reason
     138                          (let ((l (cddr line)))
     139                            (unless (null? l)
     140                              (set! made (cons s made))
     141                              (printf
     142                               "make: ~amaking ~a~a~%"
     143                               (if (make-print-checking) indent "")
     144                               s
     145                               (if (make-print-reasons)
     146                                   (cond
     147                                    ((not date)
     148                                     (string-append " because " s " does not exist"))
     149                                    ((string? reason)
     150                                     (string-append " because " reason " changed"))
     151                                    (else
     152                                     (string-append (sprintf " just because (reason: ~a date: ~a)" reason date))))
     153                                   ""))
     154                              (handle-exceptions
     155                               exn
     156                               (begin
     157                                 (printf "make: Failed to make ~a: ~a~%"
     158                                         (car line)
     159                                         (if (exn? exn)
     160                                             (exn-message exn)
     161                                             exn))
     162                                 (signal exn) )
     163                               ((car l))))))))
     164                    (unless date
     165                      (error (sprintf "don't know how to make ~a" s))))))))
     166    (cond
     167     ((string? argv) (make-file argv ""))
     168     ((or (null? argv) (equal? argv '#())) (make-file (caar spec) ""))
     169     (else (for-each (lambda (f) (make-file f ""))
     170                     (if (vector? argv) (vector->list argv) argv))))
     171    (for-each (lambda (item)
     172                (printf "make: made ~a~%" item))
     173              (reverse made))))
     174
     175(define make/proc
     176  (case-lambda
     177   ((spec) (make:make/proc/helper spec '()))
     178   ((spec argv) (make:make/proc/helper spec argv))))
     179
     180(define-syntax make
     181  (er-macro-transformer
     182   (lambda (expr rename compare)
     183     (let ((make
     184            (lambda (spec argv)
     185              (let ((form-error (lambda (s . p) (apply error s spec p))))
     186                (and (or (list? spec)
     187                         (form-error "illegal specification (not a sequence)"))
     188                     (or (pair? spec)
     189                         (form-error "empty specification"))
     190                     (every
     191                      (lambda (line)
     192                        (and
     193                         (or (and (list? line) (>= (length line) 2))
     194                             (form-error
     195                              "clause does not have at least 2 parts"
     196                              line))
     197                         (let ((name (car line)))
     198                           (or (list? (cadr line))
     199                               (form-error
     200                                "second part of clause is not a sequence"
     201                                (cadr line))))))
     202                      spec))
     203                `(,(rename 'make/proc)
     204                  (list ,@(map (lambda (line)
     205                                 `(,(rename 'list) ,(car line)
     206                                   (,(rename 'list) ,@(cadr line))
     207                                   ,@(let ((l (cddr line)))
     208                                       (if (null? l)
     209                                           '()
     210                                           `((,(rename 'lambda) ()
     211                                              ,@l))))))
     212                               spec))
     213                  ,(if (vector? argv) `',argv (car argv)))))))
     214       (cond
     215        ((null? (cdr expr))
     216         (error "no arguments to make"))
     217        ((pair? (cddr expr))
     218         (make (cadr expr) (cddr expr)))
     219        (else
     220         (make (cadr expr) '#())))))))
     221
     222)
  • release/4/make/make.setup

    r14347 r14348  
    11;;; make.setup -*- Scheme -*-
    22
    3 (run (csc -s -O2 -d1 make-support.scm -emit-exports make.exports))
     3(compile -s -O2 -d1 -j make make.scm)
     4(compile -s -O2 -d1 make.import.scm)
    45
    56(install-extension
    67 'make
    7  '("make.scm" "make-support.so")
    8  '((syntax)
    9    (version 1.3)
    10    (exports "make.exports")
    11    (documentation "make.html")
    12    (require-at-runtime make-support)) )
     8 '("make.so" "make.import.so")
     9 '((version 1.4)
     10   (documentation "make.html")))
Note: See TracChangeset for help on using the changeset viewer.