p

   1 #!/usr/bin/env gsi
   2 ;; -*- scheme -*-
   3
   4 ;; --- library stuff
   5
   6 (define (skip-head-match orig match)
   7   (let lp ((orig* orig)
   8            (match* match))
   9     (if (null? match*)
  10         orig*
  11         (if (null? orig*)
  12             orig
  13             (if (equal? (car orig*)
  14                         (car match*))
  15                 (lp (cdr orig*)
  16                     (cdr match*))
  17                 orig)))))
  18
  19 (define (basepath str)
  20   (list->string
  21    (reverse
  22     (skip-head-match
  23      (reverse (string->list str))
  24      (reverse (string->list ".scm"))))))
  25
  26 (define (run cmd . args)
  27   (let ((p (open-process (list path: (path-expand cmd)
  28                                arguments: args
  29                                stdin-redirection: #f
  30                                stdout-redirection: #f
  31                                stderr-redirection: #f))))
  32     (let ((s (process-status p)))
  33       (close-port p)
  34       (or (= s 0)
  35           ;;(error )
  36           (exit 1)))));;; how to propagate exit codes portably?
  37
  38 ;; --- / library stuff
  39
  40
  41 (define prog (car (command-line)))
  42 (define args (cdr (command-line)))
  43
  44 (define (usage maybe-err)
  45   (println
  46    (list
  47     (if maybe-err
  48         (list maybe-err "\n\n")
  49         '())
  50     "usage: "prog" path/to/file.scm"))
  51   (newline)
  52   (exit 1))
  53
  54 (if (= (length args) 1)
  55     (let ((base (basepath (car args))))
  56       (run "picobit" (string-append base ".scm"))
  57       (run "picobit-vm" (string-append base ".hex")))
  58     (usage "wrong number of arguments"))
  59