run

#!/usr/bin/env racket
#lang scheme/load

(define arcdir*
  (path->string
   (let-values (((base _2 _3)
                 (split-path (normalize-path
                              (find-system-path 'run-file)))))
     base)))

(define args (vector->list (current-command-line-arguments)))
(current-command-line-arguments (list->vector '()))

(define (next-arg)
  (if (empty? args)
       #f
       (let ((next (car args)))
         (set! args (cdr args))
         next)))

(define usepath*
  (mcons (path->string (current-directory))
         (mcons arcdir* 'nil)))
         
(namespace-require `(file ,(string-append arcdir* "/run.ss")))

(define todo '())

(define (do f)
  (set! todo (cons f todo)))

(define (doit)
  (for-each (lambda (f) (f)) (reverse todo)))

(define (do-option runtime opt)
  (cond ((equal? opt "-e")
         (let ((expr (next-arg)))
           (do (lambda ()
                 ((runtime-get runtime 'eval)
                  ((runtime-get runtime 'read) expr))))))
        ((equal? opt "-s")
         (let ((varname (next-arg)))
           (let ((value (next-arg)))
             (do (lambda ()
                   (runtime-set runtime (string->symbol varname) value))))))
        ((equal? opt "-I")
         (let ((path (next-arg)))
           (do (lambda ()
                 ((runtime-get runtime 'add-usepath) path)))))
        (else
         (error "unknown option" opt))))

(let ((runtime (new-runtime usepath*)))
  (runtime-set runtime 'arcdir* arcdir*)
  (let loop ()
    (let ((arg (next-arg)))
      (when arg
        (if (equal? arg "--")
             (current-command-line-arguments (list->vector args))
             (begin
               (if (eqv? (string-ref arg 0) #\-)
                    (do-option runtime arg)
                    (do (lambda ()
                          ((runtime-get runtime 'use-apply) arg))))
               (loop)))))))

(doit)