lfe

#! /usr/bin/env lfescript
;; -*- mode: lfe -*-
;; Copyright (c) 2008-2020 Robert Virding.
;;
;; Licensed under the Apache License, Version 2.0 (the "License");
;; you may not use this file except in compliance with the License.
;; You may obtain a copy of the License at
;;
;;     http://www.apache.org/licenses/LICENSE-2.0
;;
;; Unless required by applicable law or agreed to in writing, software
;; distributed under the License is distributed on an "AS IS" BASIS,
;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;; See the License for the specific language governing permissions and
;; limitations under the License.

(defun fix-code-path ()
  (let* ((p0 (code:get_path))
         (p1 (lists:delete "." p0)))
    (code:set_path p1)))

(defun parse-opts
  ([(cons "-h" as) opts]
   (usage)
   (tuple as opts))
  ([(list* "-I" idir as) opts]          ;Keep these in order
   (parse-opts as (++ opts `(#(i ,idir)))))
  ([(list* "-o" odir as) opts]          ;Last is first
   (parse-opts as (cons `#(outdir ,odir) opts)))
  ([(list* "-pa" dir as) opts]
   (code:add_patha dir)
   (parse-opts as opts))
  ([(list* "-pz" dir as) opts]
   (code:add_pathz dir)
   (parse-opts as opts))
  ([(cons "-v" as) opts]
   (parse-opts as (cons 'verbose opts)))
  ([(cons "-D" as) opts]
   (parse-opts as (cons 'debug-print opts)))
  ([(cons "-Werror" as) opts]
   (parse-opts as (cons 'warnings-as-errors opts)))
  ([(cons (++ "-W" _) as) opts]         ;Ignore this here
   (parse-opts as opts))
  ([(cons "-D" as) opts]
   (parse-opts as (cons 'debug-print opts)))
  ([(cons "-E" as) opts]
   (parse-opts as (cons 'to-expand opts)))
  ([(cons "-L" as) opts]
   (parse-opts as (cons 'to-lint opts)))
  ([(cons "-A" as) opts]
   (parse-opts as (cons 'to-erlang opts)))
  ([(cons "-S" as) opts]
   (parse-opts as (cons 'to-asm opts)))
  ([(cons "-P" as) opts]                ;Ignore as no LFE counterpart
   (parse-opts as opts))
  ([(cons "--" as) opts]
   (tuple as opts))
  ([(cons (cons #\+ s) as) opts]
   (let ((`#(ok ,t) (lfe_io:read_string s)))
     (parse-opts as (cons t opts))))
  ([as opts]
   (tuple as opts)))

(defun usage ()
  (let ((usage (++ "Usage: lfec [options] file ...\n\n"
                   "Options:\n\n"
                   "-h             Print usage and exit\n"
                   "-I name        Name of include directory\n"
                   "-o name        Name of output directory\n"
                   "-pa path       Add path to the front of LFE's code path\n"
                   "-pz path       Add path to the end of LFE's code path\n"
                   "-v             Verbose compiler output\n"
                   "-Werror        Make all warnings into errors\n"
                   "-Wnumber       Set warning level (ignored)\n"
                   "-D             Equivalent to +debug-print\n"
                   "-E             Equivalent to +to-expand\n"
                   "-L             Equivalent to +to-lint\n"
                   "-A             Equivalent to +to-erlang\n"
                   "-S             Equivalent to +to-asm\n"
                   "--             No more options, only file names follow\n"
                   "+term          Term will be added to options\n\n"
                   "Terms include:\n\n"
                   "+binary, +no-docs, +to-exp, +to-lint, +to-core0, +to-core, +to-kernel,\n"
                   "+to-asm, +{outdir, Dir}, +report, +return, +debug-print\n\n"
                   "Example:\n\n"
                   "$ lfec -I include -o ebin examples/ring.lfe\n\n")))
    (io:put_chars usage)))

(defun compile-file (file opts)
  (case (lfe_comp:file file opts)       ;Catch all the return values
    (`#(ok ,_) 'ok)                     ;Just as long as it worked
    (`#(ok ,_ ,_) 'ok)
    ('error 'error)                     ;Or any error
    (`#(error ,_ ,_ ,_) 'error)))

(defun compile-files
  ([(cons file files) opts]
   (case (compile-file file opts)
     ('ok (compile-files files opts))
     (_ 'error)))
  ([() _] 'ok))

;; Parse the arguments and compile the files.
(defun main (script-args)
  (case script-args
    (() (usage))
    (as0
     (fix-code-path)
     (let ((`#(,files ,opts1) (parse-opts as0 ())))
       (case (compile-files files (list* 'verbose 'report opts1))
         ('error (halt 1))
         ('ok 'ok))))))