embedded some commands for use with make into scsh

macros.scm

@@ -35,13 +35,11 @@
 						 (?prereq-pattern0 ...) 
 						 ?action0 ...))
      (lambda (maybe-target)
-       (let ((target-rx ?target-rx))
+       (let ((target-rx ?target-rx)
-	 (common-clause->func maybe-target
+	     (thunk (lambda () ?action0 ...))
-			      target-rx 
+	     (prereqs (list ?prereq-pattern0 ...)))
-			      pred
+	 (common->func maybe-target target-rx pred
-			      (?out-of-date?-func ?target-rx 
+		       ?out-of-date?-func ?target-rx prereqs thunk))))))
-						  (?prereq-pattern0 ...) 
-						  ?action0 ...)))))))
 
 (define-syntax common-%-clause->func
   (syntax-rules () 
@@ -50,91 +48,11 @@
 						(?prereq-pattern0 ...) 
 						?action0 ...))
      (lambda (maybe-target)
-       (let* ((pattern ?target-pattern)
+       (let ((target-rx (%-pattern->rx ?target-pattern))
-	      (left (common-%-pattern->match pattern 1))
+	     (thunk (lambda () ?action0 ...))
-	      (middle (common-%-pattern->match pattern 2))
+	     (prereqs (list ?prereq-pattern0 ...)))
-	      (right (common-%-pattern->match pattern 3))
+	 (common->func maybe-target target-rx pred
-	      (target-rx (if (string=? "%" middle)
+		       ?out-of-date?-func ?target-pattern prereqs thunk))))))
-			     (rx (: (submatch (: bos ,left))
-				    (submatch (* any))
-				    (submatch (: ,right eos))))
-			     (rx (: (submatch (: bos ,left))
-				    (submatch ,middle)
-				    (submatch (: ,right eos)))))))
-	 (common-clause->func maybe-target 
-			      target-rx 
-			      pred
-			      (?out-of-date?-func ?target-pattern
-						  (?prereq-pattern0 ...)
-						  ?action0 ...)))))))
-
-(define-syntax common-%-pattern->match
-  (syntax-rules () 
-    ((common-%-pattern->match ?target-pattern ?no)
-     (match:substring (regexp-search (rx (: (submatch (: bos (* any)))
-					    (submatch "%") 
-					    (submatch (: (* any) eos))))
-				     ?target-pattern)
-		      ?no))))
-
-(define-syntax common-s/%/match
-  (syntax-rules () 
-    ((common-s/%/match ?pattern ?match)
-     (regexp-substitute/global 
-      #f (rx (: (submatch (: bos (* any)))
-		(submatch "%") 
-		(submatch (: (* any) eos)))) ?pattern 'pre 1 ?match 3 'post))))
-
-(define-syntax common-clause->func
-  (syntax-rules () 
-    ((common-clause->func maybe-target 
-			  target-rx 
-			  pred
-			  (?out-of-date?-func ?target-pattern 
-					      (?prereq-pattern0 ...) 
-					      ?action0 ...))
-     (let* ((match-data (regexp-search target-rx maybe-target))
-	    (maybe-target-matches (if match-data 
-				      (map (lambda (no)
-					     (match:substring match-data no))
-					   (list 1 2 3))
-				      #f)))
-       (if maybe-target-matches
-	   (let* ((left (list-ref maybe-target-matches 0))
-		  (target-match (list-ref maybe-target-matches 1))
-		  (right (list-ref maybe-target-matches 2))
-		  (target-name (string-append left target-match right))
-		  (prereqs (list ?prereq-pattern0 ...))
-		  (cooked-prereqs (map (lambda (prereq) 
-					 (if (string? prereq)
-					     (common-s/%/match prereq target-match)
-					     prereq))
-				       prereqs)))
-	     (make-rule-cand target-name
-			     cooked-prereqs
-			     ;;out-to-date?-func 
-			     (lambda args 
-			       (let ((init-state (last args)))
-				 (cons (bind-fluids-common 
-					target-name left target-match right
-					(lambda () 
-					  (?out-of-date?-func target-name 
-							      cooked-prereqs)))
-				       init-state)))
-			     ;; build-func 
-			     (lambda args 
-			       (let ((cooked-state (last args))
-				     (prereqs-results (cdr (reverse (cdr args)))))
-				 (cons (bind-fluids-common 
-					target-name left target-match right
-					(lambda () 
-					  (bind-all-fluids target-name 
-							   cooked-prereqs 
-							   prereqs-results 
-							   (lambda () 
-							     ?action0 ...))))
-				       cooked-state)))))
-	   #f)))))
 
 (define-syntax clause->rc
   (syntax-rules ()

make.scm

@@ -8,3 +8,166 @@
       (map (lambda (t) 
 	     (rule-make t init-state rule-set))
 	   target-rules))))
+
+(define (make-rc target prereqs out-of-date?-func thunk)
+  (make-rule-cand target 
+		  prereqs
+		  (lambda args 
+		    (let ((init-state (last args)))
+		      (cons (out-of-date?-func target prereqs)
+			    init-state)))
+		  (lambda args 
+		    (let ((cooked-state (last args))
+			  (results (cdr (reverse (cdr args)))))
+		      (cons (bind-all-fluids target prereqs results thunk)
+			    cooked-state)))))
+
+(define (file->rc target prereqs thunk)
+  (make-rc target prereqs file thunk))
+
+(define (once->rc target prereqs thunk)
+  (make-rc target prereqs once thunk))
+
+(define (all->rc target prereqs thunk)
+  (make-rc target prereqs all thunk))
+
+(define (always->rc target prereqs thunk)
+  (make-rc target prereqs always thunk))
+
+(define (perms->rc target prereqs thunk)
+  (make-rc target prereqs perms thunk))
+
+(define (md5->rc target prereqs thunk)
+  (make-rc target prereqs md5 thunk))
+
+(define (md5-perms->rc target prereqs thunk)
+  (make-rc target prereqs md5-perms thunk))
+
+(define (paranoid->rc target prereqs thunk)
+  (make-rc target prereqs paranoid thunk))
+
+(define (subst-% pattern match)
+  (regexp-substitute/global #f (rx (: (submatch (: bos (* any)))
+				      (submatch "%") 
+				      (submatch (: (* any) eos))))
+			    pattern 'pre 1 match 3 'post))
+
+(define (%-pattern->match pattern no)
+  (match:substring (regexp-search (rx (: (submatch (: bos (* any)))
+					 (submatch "%") 
+					 (submatch (: (* any) eos))))
+				  pattern)
+		   no))
+
+(define (%-pattern->rx pattern)
+  (let* ((left (%-pattern->match pattern 1))
+	 (middle (%-pattern->match pattern 2))
+	 (right (%-pattern->match pattern 3))
+	 (target-rx (if (string=? "%" middle)
+			(rx (: (submatch (: bos ,left))
+			       (submatch (* any))
+			       (submatch (: ,right eos))))
+			(rx (: (submatch (: bos ,left))
+			       (submatch ,middle)
+			       (submatch (: ,right eos)))))))
+    target-rx))
+
+(define (file-rx->rc target prereqs thunk)
+  (rx->func string=? target prereqs file thunk))
+
+(define (once-rx->rc target prereqs thunk)
+  (rx->func string=? target prereqs once thunk))
+
+(define (all-rx->rc target prereqs thunk)
+  (rx->func string=? target prereqs all thunk))
+
+(define (always-rx->rc target prereqs thunk)
+  (rx->func string=? target prereqs always thunk))
+
+(define (perms-rx->rc target prereqs thunk)
+  (rx->func string=? target prereqs perms thunk))
+
+(define (md5-rx->rc target prereqs thunk)
+  (rx->func string=? target prereqs md5 thunk))
+
+(define (md5-perms-rx->rc target prereqs thunk)
+  (rx->func string=? target prereqs md5-perms thunk))
+
+(define (paranoid-rx->rc target prereqs thunk)
+  (rx->func string=? target prereqs paranoid thunk))
+
+(define (rx->func pred target-rx prereqs out-of-date?-func thunk)
+  (lambda (maybe-target)
+    (common->func maybe-target target-rx pred
+		  out-of-date?-func target-rx prereqs thunk)))
+
+(define (file-%->rc target prereqs thunk)
+  (%->func string=? target prereqs file thunk))
+
+(define (once-%->rc target prereqs thunk)
+  (%->func string=? target prereqs once thunk))
+
+(define (all-%->rc target prereqs thunk)
+  (%->func string=? target prereqs all thunk))
+
+(define (always-%->rc target prereqs thunk)
+  (%->func string=? target prereqs always thunk))
+
+(define (perms-%->rc target prereqs thunk)
+  (%->func string=? target prereqs perms thunk))
+
+(define (md5-%->rc target prereqs thunk)
+  (%->func string=? target prereqs md5 thunk))
+
+(define (md5-perms-%->rc target prereqs thunk)
+  (%->func string=? target prereqs md5-perms thunk))
+
+(define (paranoid-%->rc target prereqs thunk)
+  (%->func string=? target prereqs paranoid thunk))
+
+(define (%->func pred target-pattern prereqs out-of-date?-func thunk)
+  (lambda (maybe-target)
+    (let ((target-rx (%-pattern->rx target-pattern)))
+      (common->func maybe-target target-rx pred 
+		    out-of-date?-func target-pattern prereqs thunk))))
+
+(define (common->func maybe-target target-rx pred 
+		      out-of-date?-func target-pattern prereqs thunk)
+  (let* ((match-data (regexp-search target-rx maybe-target))
+	 (maybe-target-matches (if match-data 
+				   (map (lambda (no)
+					  (match:substring match-data no))
+					(list 1 2 3))
+				   #f)))
+    (if maybe-target-matches
+	(let* ((left (list-ref maybe-target-matches 0))
+	       (target-match (list-ref maybe-target-matches 1))
+	       (right (list-ref maybe-target-matches 2))
+	       (target-name (string-append left target-match right))
+	       (cooked-prereqs (map (lambda (prereq) 
+				      (if (string? prereq)
+					  (subst-% prereq target-match)
+					  prereq))
+				    prereqs)))
+	  (make-rule-cand target-name
+			  cooked-prereqs
+			  (lambda args 
+			    (let ((init-state (last args)))
+			      (cons (bind-fluids-common 
+				     target-name left target-match right
+				     (lambda () 
+				       (out-of-date?-func target-name 
+							  cooked-prereqs)))
+				    init-state)))
+			  (lambda args 
+			    (let ((cooked-state (last args))
+				  (prereqs-results (cdr (reverse (cdr args)))))
+			      (cons (bind-fluids-common 
+				     target-name left target-match right
+				     (lambda () 
+				       (bind-all-fluids target-name 
+							cooked-prereqs 
+							prereqs-results 
+							thunk)))
+				    cooked-state)))))
+	#f)))

packages.scm

@@ -182,10 +182,8 @@
 	srfi-1
 	to-rule-set
 	rule-cand
-	dfs
 	autovars
-	templates
+	make)
-	make-rule)
   (files macros))
 
 (define-interface to-rule-set-interface
@@ -328,12 +326,48 @@
 	srfi-9)
   (files rule-cand))
 
-(define-structure make (export make)
+(define-interface make-interface
+  (export make
+	  make-rc
+	  file->rc
+	  once->rc
+	  all->rc
+	  always->rc
+	  perms->rc
+	  md5->rc
+	  md5-perms->rc
+	  paranoid->rc
+	  %-pattern->match
+	  %-pattern->rx
+	  file-rx->rc
+	  once-rx->rc
+	  all-rx->rc
+	  always-rx->rc
+	  perms-rx->rc
+	  md5-rx->rc
+	  md5-perms-rx->rc
+	  paranoid-rx->rc
+	  file-%->rc
+	  once-%->rc
+	  all-%->rc
+	  always-%->rc
+	  perms-%->rc
+	  md5-%->rc
+	  md5-perms-%->rc
+	  paranoid-%->rc
+	  %->func
+	  rx->func
+	  common->func))
+
+(define-structure make make-interface
   (open scheme-with-scsh
 	srfi-1
-	macros
+;	macros
 	let-opt
 	to-rule-set
+	templates
+	autovars
+	rule-cand
 	make-rule)
   (files make))