; make

(define (string-split sep str)
  (define (f cs xs) (cons (list->string (reverse cs)) xs))
  (let loop ((ss (string->list str)) (cs '()) (xs '()))
    (cond ((null? ss) (reverse (if (null? cs) xs (f cs xs))))
          ((char=? (car ss) sep) (loop (cdr ss) '() (f cs xs)))
          (else (loop (cdr ss) (cons (car ss) cs) xs)))))

(define (exec commands)
  (when (pair? commands)
    (display (car commands)) (newline)
    (exec (cdr commands))))

(define (read-makefile makefile)
  (define (but-last str)
    (list->string (reverse (cdr (reverse (string->list str))))))
  (define (end-first-word line)
    (let ((words (string-split #\space line)))
      (if (not (positive? (length words))) #\space
        (car (reverse (string->list (car words)))))))
  (define (get-name line)
    (but-last (car (string-split #\space line))))
  (define (get-preds line)
    (cdr (string-split #\space line)))
  (with-input-from-file makefile
    (lambda ()
      (let loop ((line (read-line)) (name "") (preds (list))
                 (cmds (list)) (rules (list)))
        (cond ((eof-object? line)
                (if (null? cmds) rules
                  (cons (list name preds (reverse cmds)) rules)))
              ((char=? (end-first-word line) #\:) ; new rule
                (loop (read-line) (get-name line) (get-preds line) (list)
                  (if (zero? (string-length name)) (list)
                    (cons (list name preds (reverse cmds)) rules))))
              ((and (positive? (string-length line))
                    (char=? (string-ref line 0) #\tab)) ; command
                (loop (read-line) name preds
                  (cons (substring line 1 (string-length line)) cmds) rules))
              (else (loop (read-line) name preds cmds rules)))))))

(define (newer? x y)
  (define (mktemp prefix)
    (let loop ((n 0))
      (let ((file (string-append prefix (number->string n))))
        (if (file-exists? file) (loop (+ n 1)) file))))
  (let ((tempfile (mktemp "temp")))
    (system (string-append "ls -t >" tempfile))
    (let ((p (open-input-file tempfile)))
      (define (return val)
        (close-port p) (delete-file tempfile) val)
      (let loop ((z (read-line p)))
        (cond ((eof-object? z) (return #f))
              ((string=? z x) (return #t))
              ((string=? z y) (return #f))
              (else (loop (read-line p))))))))

(define (make target makefile)
  (define (check target makefile)
    (if (not (or (file-exists? target) (assoc target makefile)))
      (error 'make "don't know how to make " target)))
  (check target makefile)
  (if (all? (lambda (pred) (newer? pred target)) (cadr (assoc target makefile)))
      (string-append target " is up to date")
      (let loop ((target target) (preds (cadr (assoc target makefile))))
        (if (null? preds)
            (exec (caddr (assoc target makefile)))
            (if (newer? (car preds) target)
                (loop target (cdr preds))
                (begin (loop (car preds) (cadr (assoc (car preds) makefile)))
                       (loop target (cdr preds))))))))