loki/src/loki.scm at 0749fdd46d089fb0aa4216f8500c1df116ab30fd · rickbutton/loki · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
(import (scheme base))
(import (scheme write))
(import (scheme process-context))
(import (loki util))
(import (loki path))
(import (loki compiler loader))
(import (loki compiler runtime))
(import (loki compiler lang core))
(import (srfi 37))

(define *version* "0.0.1")
(define (version-string)
  (string-append
    "loki v" *version* "\n"))

(define opt-debug debug)

(define-record-type <loki-options>
  (make-loki-options targets args)
  loki-options?
  (targets loki-options-targets loki-options-targets-set!)
  (args    loki-options-args    loki-options-args-set!))
(define (default-options)
  (make-loki-options '() '()))

(define (display-and-exit-proc msg)
  (lambda (opt name arg options)
    (display msg)
    (exit 0)))

(define (parse-options arguments)
  (args-fold
    arguments
    (list (option '(#\v "version") #f #f
                  (display-and-exit-proc (version-string)))
          (option '(#\h "help") #f #f
                  (display-and-exit-proc
                   "Usage: TODO, someone please fill this in..."))
          (option '(#\n #\q "nodebug" "quiet") #f #f
		  (lambda (opt name arg options)
		    (set! opt-debug (lambda args #f))
		    options)))
    (lambda (opt name arg loads)
      (error "Unrecognized option" name))
    (let ((mode 'targets)) ; targets | options
      (lambda (op options)
        (if (string=? op "--")
          (set! mode 'args)
          (case mode
            ((targets)
             (loki-options-targets-set! options (append (loki-options-targets options) (list op))))
            ((args)
             (loki-options-args-set! options (append (loki-options-args options) (list op))))))
          options))
    (default-options)))

(define (run-loki-cli arguments)
  (let ((options (parse-options arguments)))
    (if (null? options)
      (error "target required"))
    (with-loki-command-line (loki-options-args options) (lambda ()
      (for-each
        (lambda (target)
          (load-module-from-cache (make-path target) opt-debug))
        (loki-options-targets options))))))

(with-exception-handler
  (lambda (error)
    (if (runtime-exception? error)
        (debug "runtime exception"
               (runtime-exception-type error)
               (runtime-exception-message error)
               (runtime-exception-irritants error))
        (debug error))
    (raise error))
  (lambda () (run-loki-cli (cdr (command-line)))))