scsh-make/makros.scm

(define *fname->rule*-table '())
(define rule-set (make-empty-rule-set))

;;; (*fname->rule*-get fname) ---> rule
(define (*fname->rule*-get fname)
  (let ((rule-found? (assoc fname *fname->rule*-table)))
    (if rule-found? (cdr rule-found?))))

;;; (*fname->rule*-add! fname) ---> {}
(define (*fname->rule*-add! fname rule)
  (let ((rule-found? (assoc fname *fname->rule*-table)))
    (if rule-found?
	(error "There already exists a rule with this fname!")
	(begin 
	  (set! *fname->rule*-table 
		(alist-cons fname rule *fname->rule*-table))
	  (set! rule-set (rule-set-add rule rule-set))))))

(define-syntax make
  (syntax-rules ()
    ((make ?fname ?state)
     (rule-make (*fname->rule*-get ?fname)
		?state
		rule-set))))

(define-syntax makefile
  (syntax-rules () 
    ((makefile ?rule0 ...)
     (begin 
       (set! rule-set (make-empty-rule-set))
       ?rule0 ...))))

(define-syntax make-is-out-of-date? 
  (syntax-rules () 
    ((make-is-out-of-date? ?target)
     (lambda ?args
       (cons (file-not-exists? ?target) ?args)))
    ((make-is-out-of-date? ?target ?prereq0 ...)
     (lambda ?args
       (cons (or (file-not-exists? ?target)
		 (> (file-last-mod ?prereq0)
		    (file-last-mod ?target))
		 ...)
	     (last ?args))))))

(define-syntax make-has-md5-digest=?
  (syntax-rules () 
    ((make-has-md5-digest=? ?fingerprint ?target)
     (lambda ?args
       (cons (or (file-not-exists? ?target)
		 (=? (md5-digest-for-port (open-input-file ?target))
		     ?fingerprint))
	     ?args)))
    ((make-has-md5-digest=? ?fingerprint ?target ?prereq0 ...)
     (lambda ?args
       (cons (or (file-not-exists? ?target)
		 (=? (md5-digest->number (md5-digest-for-port 
					  (open-input-file ?target)))
		     (md5-digest->number ?fingerprint)))
	     (last ?args))))))

(define-syntax makefile-rule
  (syntax-rules ()
    ((makefile-rule ?target (?prereq0 ...) ?thunk)
     (makefile-rule-tmpvars () ?target (?prereq0 ...) ?thunk))))

(define-syntax makefile-rule-tmpvars
  (syntax-rules ()
    ((makefile-rule-tmpvars (tmp1 ...) ?target () ?thunk)
     ;; 
     ;; ?target could be an expr: eval only once
     ;; 
     (let ((target ?target))
       (*fname->rule*-add! target
			   (make-rule (list (*fname->rule*-get tmp1)
					    ...)
				      (make-is-out-of-date? target tmp1 ...)
				      (lambda ?args (?thunk))))))
    ;;
    ;; recursively construct temporary, hygienic variables
    ;;
    ((makefile-rule-tmpvars (tmp1 ...) ?target (?prereq0 ?prereq1 ...) ?thunk)
     (let ((tmp2 ?prereq0))
       (makefile-rule-tmpvars (tmp1 ... tmp2) ?target (?prereq1 ...) ?thunk)))))

(define-syntax makefile-rule-md5
  (syntax-rules ()
    ((makefile-rule-md5 ?fingerprint ?target (?prereq0 ...) ?thunk)
     (makefile-rule-md5-tmpvars () ?fingerprint ?target (?prereq0 ...) ?thunk))))

(define-syntax makefile-rule-md5-tmpvars
  (syntax-rules ()
    ((makefile-rule-md5-tmpvars (tmp1 ...) ?fingerprint ?target () ?thunk)
     ;; 
     ;; ?target could be an expr: eval only once
     ;; 
     (let ((target ?target))
       (*fname->rule*-add! target
			   (make-rule (list (*fname->rule*-get tmp1)
					    ...)
				      (make-has-md5-digest=? ?fingerprint 
							     target 
							     tmp1 ...)
				      (lambda ?args (?thunk))))))
    ;;
    ;; recursively construct temporary, hygienic variables
    ;;
    ((makefile-rule-md5-tmpvars (tmp1 ...) 
				?fingerprint 
				?target 
				(?prereq0 ?prereq1 ...) 
				?thunk)
     (let ((tmp2 ?prereq0))
       (makefile-rule-md5-tmpvars (tmp1 ... tmp2) 
				  ?fingerprint 
				  ?target 
				  (?prereq1 ...) 
				  ?thunk)))))