1#! /usr/bin/env lfe
2;; -*- mode: lfe; -*-
3;; Copyright (c) 2008-2014 Robert Virding.
4;;
5;; Licensed under the Apache License, Version 2.0 (the "License");
6;; you may not use this file except in compliance with the License.
7;; You may obtain a copy of the License at
8;;
9;;     http://www.apache.org/licenses/LICENSE-2.0
10;;
11;; Unless required by applicable law or agreed to in writing, software
12;; distributed under the License is distributed on an "AS IS" BASIS,
13;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
14;; See the License for the specific language governing permissions and
15;; limitations under the License.
16
17(defun fix-code-path ()
18  (let* ((p0 (code:get_path))
19         (p1 (lists:delete "." p0)))
20    (code:set_path p1)))
21
22(defun parse-opts
23  ([(cons "-h" as) opts]
24   (usage)
25   (tuple as opts))
26  ([(list* "-I" idir as) opts]          ;Keep these in order
27   (parse-opts as (++ opts `(#(i ,idir)))))
28  ([(list* "-o" odir as) opts]          ;Last is first
29   (parse-opts as (cons `#(outdir ,odir) opts)))
30  ([(list* "-pa" dir as) opts]
31   (code:add_patha dir)
32   (parse-opts as opts))
33  ([(list* "-pz" dir as) opts]
34   (code:add_pathz dir)
35   (parse-opts as opts))
36  ([(cons "-v" as) opts]
37   (parse-opts as (cons 'verbose opts)))
38  ([(cons "-D" as) opts]
39   (parse-opts as (cons 'debug-print opts)))
40  ([(cons "-Werror" as) opts]
41   (parse-opts as (cons 'warnings-as-errors opts)))
42  ([(cons (++* "-W" _) as) opts]        ;Ignore this here
43   (parse-opts as opts))
44  ([(cons "-D" as) opts]
45   (parse-opts as (cons 'debug-print opts)))
46  ([(cons "-E" as) opts]
47   (parse-opts as (cons 'to-exp opts)))
48  ([(cons "-L" as) opts]
49   (parse-opts as (cons 'to-lint opts)))
50  ([(cons "-S" as) opts]
51   (parse-opts as (cons 'to-asm opts)))
52  ([(cons "-P" as) opts]                ;Ignore as no LFE counterpart
53   (parse-opts as opts))
54  ([(cons "--" as) opts]
55   (tuple as opts))
56  ([(cons (cons #\+ s) as) opts]
57   (let ((`#(ok ,t) (lfe_io:read_string s)))
58     (parse-opts as (cons t opts))))
59  ([as opts]
60   (tuple as opts)))
61
62(defun usage ()
63  (let ((usage (++ "Usage: lfec [options] file ...\n\n"
64                   "Options:\n"
65                   "-h             Print usage and exit\n"
66                   "-I name        Name of include directory\n"
67                   "-o name        Name of output directory\n"
68                   "-pa path       Add path to the front of LFE's code path\n"
69                   "-pz path       Add path to the end of LFE's code path\n"
70                   "-v             Verbose compiler output\n"
71                   "-Werror        Make all warnings into errors\n"
72                   "-Wnumber       Set warning level (ignored)\n"
73                   "-D             Equivalent to +debug-print\n"
74                   "-L             Equivalent to +to-lint\n"
75                   "-E             Equivalent to +to-exp\n"
76                   "-S             Equivalent to +to-asm\n"
77                   "--             No more options, only file names follow\n"
78                   "+term          Term will be added to options\n\n"
79                   "Terms include:\n\n"
80                   "+binary, +no-docs, +to-exp, +to-lint, +to-core0, +to-core, +to-kernel, +to-asm\n"
81                   "+{outdir, Dir}, +report, +return, +debug-print\n")))
82    (io:put_chars usage)))
83
84(defun compile-file (file opts)
85  (case (lfe_comp:file file opts)       ;Catch all the return values
86    (`#(ok ,_) 'ok)                     ;Just as long as it worked
87    (`#(ok ,_ ,_) 'ok)
88    ('error 'error)                     ;Or any error
89    (`#(error ,_ ,_ ,_) 'error)))
90
91(defun compile-files
92  ([(cons file files) opts]
93   (case (compile-file file opts)
94     ('ok (compile-files files opts))
95     (_ 'error)))
96  ([() _] 'ok))
97
98;; Parse the arguments and compile the files.
99(case script-args
100  (() (usage))
101  (as0
102   (fix-code-path)
103   (let ((`#(,files ,opts1) (parse-opts as0 ())))
104     (case (compile-files files (list* 'verbose 'report opts1))
105       ('error (halt 1))
106       ('ok 'ok)))))
107