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