Initial import

private/commands.rkt

@@ -0,0 +1,82 @@
+#lang racket/base
+
+(require file/glob
+         racket/file
+         racket/list
+         racket/string
+         racket/system
+         "engine.rkt")
+
+(provide run
+         rm-f
+         rm-rf
+         cleanup)
+
+(define (recipe-value who parameter description)
+  (define value (parameter))
+  (unless value
+    (error who "~a is only available while a target recipe is running" description))
+  value)
+
+(define (command-item->strings value)
+  (cond
+    [(eq? value '$target)
+     (list (recipe-value 'run current-target "$target"))]
+    [(eq? value '$deps)
+     (recipe-value 'run current-dependencies "$deps")]
+    [(eq? value '$<)
+     (define first (current-first-dependency))
+     (unless first
+       (error 'run "$< is not available: this target has no dependencies"))
+     (list first)]
+    [(symbol? value) (list (symbol->string value))]
+    [(path? value) (list (path->string value))]
+    [(string? value) (list value)]
+    [(number? value) (list (number->string value))]
+    [(list? value) (append-map command-item->strings value)]
+    [else
+     (raise-argument-error
+      'run
+      "command item (string, symbol, path, number, or list)"
+      value)]))
+
+(define (run command)
+  (unless (list? command)
+    (raise-argument-error 'run "list?" command))
+  (define arguments (append-map command-item->strings command))
+  (when (null? arguments)
+    (error 'run "empty command"))
+  (define program (car arguments))
+  (define executable
+    (or (find-executable-path program)
+        (and (file-exists? program) (path->complete-path program))
+        (error 'run "executable not found: ~a" program)))
+  (printf "> ~a\n" (string-join arguments " "))
+  (unless (apply system* executable (cdr arguments))
+    (error 'run "command failed: ~a" program))
+  (void))
+
+(define (rm-f . paths)
+  (for ([path (in-list paths)])
+    (case (file-or-directory-type path #f)
+      [(file link) (delete-file path)]
+      [(directory-link) (delete-directory path)]
+      [(directory)
+       (error 'rm-f "refusing to remove directory without recursion: ~a" path)]
+      [else (void)]))
+  (void))
+
+(define (rm-rf . paths)
+  (for ([path (in-list paths)])
+    (delete-directory/files path #:must-exist? #f))
+  (void))
+
+(define (cleanup directory patterns)
+  (unless (list? patterns)
+    (raise-argument-error 'cleanup "list?" patterns))
+  (for* ([pattern (in-list patterns)]
+         [path (in-glob (build-path directory pattern))])
+    (case (file-or-directory-type path #f)
+      [(file link) (rm-f path)]
+      [else (void)]))
+  (void))

private/engine.rkt

@@ -0,0 +1,147 @@
+#lang racket/base
+
+(require racket/list)
+
+(provide register-target!
+         mark-phony!
+         set-default-target!
+         reset-makefile!
+         run-selected-target!
+         current-target
+         current-dependencies
+         current-first-dependency)
+
+(struct target-definition (name dependencies recipe) #:transparent)
+
+(define targets (make-hash))
+(define phony-targets (make-hash))
+(define target-order '())
+(define default-target-name #f)
+
+(define current-target (make-parameter #f))
+(define current-dependencies (make-parameter #f))
+(define current-first-dependency (make-parameter #f))
+
+(define (target-key value)
+  (cond
+    [(symbol? value) (symbol->string value)]
+    [(path? value) (path->string value)]
+    [(string? value) value]
+    [else (raise-argument-error 'target "(or/c symbol? path-string?)" value)]))
+
+(define (reset-makefile!)
+  (hash-clear! targets)
+  (hash-clear! phony-targets)
+  (set! target-order '())
+  (set! default-target-name #f))
+
+(define (target-keys value)
+  (if (list? value)
+      (append-map target-keys value)
+      (list (target-key value))))
+
+(define (register-target! name dependencies recipe)
+  (define key (target-key name))
+  (unless (hash-has-key? targets key)
+    (set! target-order (append target-order (list key))))
+  (hash-set! targets
+             key
+             (target-definition key
+                                (append-map target-keys dependencies)
+                                recipe))
+  (void))
+
+(define (mark-phony! . names)
+  (for* ([name (in-list names)]
+         [key (in-list (target-keys name))])
+    (hash-set! phony-targets key #t))
+  (void))
+
+(define (set-default-target! name)
+  (set! default-target-name (target-key name))
+  (void))
+
+(define (phony? name)
+  (hash-ref phony-targets name #f))
+
+(define (path-modify-seconds path)
+  (file-or-directory-modify-seconds path #f (lambda () #f)))
+
+(define (dependency-time name built-results)
+  (cond
+    [(phony? name) +inf.0]
+    [(hash-has-key? targets name)
+     (define result (hash-ref built-results name #f))
+     (or (path-modify-seconds name)
+         (and result +inf.0)
+         #f)]
+    [else
+     (or (path-modify-seconds name)
+         (error 'racket-makefile "dependency does not exist and has no target: ~a" name))]))
+
+(define (needs-build? definition built-results)
+  (define name (target-definition-name definition))
+  (cond
+    [(phony? name) #t]
+    [else
+     (define target-time (path-modify-seconds name))
+     (cond
+       [(not target-time) #t]
+       [else
+        (for/or ([dependency (in-list (target-definition-dependencies definition))])
+          (define dep-time (dependency-time dependency built-results))
+          (and dep-time (> dep-time target-time)))])]))
+
+(define (execute-target! definition)
+  (define name (target-definition-name definition))
+  (define dependencies (target-definition-dependencies definition))
+  (printf "racket-makefile: ~a\n" name)
+  (parameterize ([current-target name]
+                 [current-dependencies dependencies]
+                 [current-first-dependency (and (pair? dependencies) (car dependencies))])
+    ((target-definition-recipe definition))))
+
+(define (build-target! name built-results visiting)
+  (define key (target-key name))
+  (cond
+    [(hash-has-key? built-results key)
+     (hash-ref built-results key)]
+    [(hash-has-key? visiting key)
+     (error 'racket-makefile "dependency cycle involving target: ~a" key)]
+    [else
+     (define definition
+       (hash-ref targets key
+                 (lambda ()
+                   (error 'racket-makefile "unknown target: ~a" key))))
+     (hash-set! visiting key #t)
+     (for ([dependency (in-list (target-definition-dependencies definition))])
+       (if (hash-has-key? targets dependency)
+           (build-target! dependency built-results visiting)
+           (unless (path-modify-seconds dependency)
+             (error 'racket-makefile
+                    "dependency does not exist and has no target: ~a"
+                    dependency))))
+     (define rebuilt? (needs-build? definition built-results))
+     (when rebuilt?
+       (execute-target! definition))
+     (hash-remove! visiting key)
+     (hash-set! built-results key rebuilt?)
+     rebuilt?]))
+
+(define (selected-targets)
+  (define args (vector->list (current-command-line-arguments)))
+  (cond
+    [(pair? args) args]
+    [default-target-name (list default-target-name)]
+    [(pair? target-order) (list (car target-order))]
+    [else '()]))
+
+(define (run-selected-target!)
+  (define names (selected-targets))
+  (when (null? names)
+    (error 'racket-makefile "no target defined"))
+  (define built-results (make-hash))
+  (define visiting (make-hash))
+  (for ([name (in-list names)])
+    (build-target! name built-results visiting))
+  (void))