;;;
;;; precomp - Precompiler
;;;
;;;   Copyright (c) 2004-2009 Shiro Kawai, All rights reserved.
;;;
;;;   Redistribution and use in source and binary forms, with or without
;;;   modification, are permitted provided that the following conditions
;;;   are met:
;;;
;;;   1. Redistributions of source code must retain the above copyright
;;;      notice, this list of conditions and the following disclaimer.
;;;
;;;   2. Redistributions in binary form must reproduce the above copyright
;;;      notice, this list of conditions and the following disclaimer in the
;;;      documentation and/or other materials provided with the distribution.
;;;
;;;   3. Neither the name of the authors nor the names of its contributors
;;;      may be used to endorse or promote products derived from this
;;;      software without specific prior written permission.
;;;
;;;   THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
;;;   "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
;;;   LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
;;;   A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
;;;   OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
;;;   SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
;;;   TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
;;;   PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
;;;   LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
;;;   NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;;;   SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;;;

;;;
;;; This is a hack to "compile" the Scheme-written compiler into static
;;; C data structure, so that it can be linked into libgauche.
;;;

(use file.util)
(use gauche.cgen.precomp)
(use gauche.parseopt)
(use scheme.list)
(use srfi.13)
(use util.match)

(define (main args)
  (let ([predef-syms '()]
        [includes '()])
    (let-args (cdr args)
        ([help               "h|help" => (^[] (usage #f))]
         [inc                "I=s" => (^v (push! includes v))]
         [keep-private-macro "M|keep-private-macro=s"]
         [ext-main           "e|ext-main"]
         [xprefix            "p|strip-prefix=s"]
         [xprefix-all        "P|strip-prefix-all"]
         [out.sci            "i|interface=s"]
         [out.c              "o|output=s"]
         [single-sci         "single-interface"]
         [subinits           "s|sub-initializers=s"]
         [dso-name           "d|dso-name=s"]
         [target-config      "target-config=s"]
         [omit-debug-source-info "omit-debug-source-info"]
         [ext-module         "ext-module=s" #f] ;for backward compatibility
         [#f "D=s" => (^[sym] (push! predef-syms sym))]
         [else (opt . _) (usage #"Unrecognized option: ~opt")]
         . args)
      (let ([mtk      (split-to-symbols keep-private-macro)]
            [subinits (split-to-symbols subinits)]
            [extini   (or ext-module ext-main)]
            [prefix   (or xprefix-all xprefix)]
            [omit-line-directives
             (sys-getenv "GAUCHE_PRECOMP_OMIT_LINE_DIRECTIVES")]
            [tparams  (if target-config
                        (load-target-config target-config)
                        '())])
        (match args
          [() (usage #f)]
          [(src)
           (when single-sci
             (usage "The `--single-interface' option is only valid with multiple input files"))
           (cgen-precompile src
                            :out.c out.c
                            :out.sci (or out.sci ext-module)
                            :load-paths (reverse includes)
                            :strip-prefix prefix
                            :ext-initializer extini
                            :sub-initializers subinits
                            :dso-name dso-name
                            :omit-line-directives omit-line-directives
                            :omit-debug-source-info omit-debug-source-info
                            :predef-syms predef-syms
                            :target-parameters tparams
                            :macros-to-keep mtk)]
          [(srcs ...)
           (when out.sci
             (usage "The `-i' or `--interface' option is only valid with single input file"))
           (cgen-precompile-multi srcs
                                  :ext-initializer extini
                                  :strip-prefix prefix
                                  :single-sci-file single-sci
                                  :dso-name dso-name
                                  :load-paths (reverse includes)
                                  :omit-line-directives omit-line-directives
                                  :omit-debug-source-info omit-debug-source-info
                                  :predef-syms predef-syms
                                  :target-parameters tparams
                                  :macros-to-keep mtk)]))))
  0)

(define (usage msg)
  (when msg (print msg))
  (print
   "Usage: gosh precomp [options] <file.scm> ...\
  \nOptions:\
  \n  -i,--interface=FILE.SCI\
  \n      Specify output interface file.  Valid only for single input file.\
  \n      If omitted, input filename with '.sci' extension is used.\
  \n  --single-interface\
  \n      Generate single interface file, instead of one for each input file.\
  \n      Valid only for multiple input files.  The first source file name\
  \n      is used, except the extension is swapped for '.sci'.\
  \n  -o,--output=FILE.C\
  \n      Specifies output file name.  If omitted, the input file name with\
  \n      '.c' extension is used.  Valid only for single input file.\
  \n  -D=NAME\
  \n      Insert '#define NAME' at the beginning of output file.  This option\
  \n      can be specified multiple times.\
  \n  -p,--strip-prefix=PREFIX\
  \n      Remove PREFIX from the input file names to produce output file names.\
  \n      Useful if the source files are in a separate directory.\
  \n  -P,--strip-prefix-all\
  \n      Remove all directory names from the input file names, just use their\
  \n      basenames, to produce output file names.\
  \n  -e, --ext-main\
  \n      Generate source for an extension module rather than a standalone\
  \n      executable.  The initialization function follows the protocol of\
  \n      Gauche extension initializer.\
  \n  --keep-private-macro=NAME,NAME,...\
  \n      If a macro is not exported, it won't be emitted to the precompiled\
  \n      file by default.  With this option, the named macros are kept in\
  \n      the output even if they're private to the module.\
  \n  --omit-debug-source-info\
  \n      Do not include debug source info to the precompiled code.  This\
  \n      does not affect the behavior of the code, but disassembling\
  \n      won't show the source info.\
  \n  --target-config=FILE\
  \n      Give the target parameter configuration, if it is different\
  \n      from the compiling gosh.  The file must contain a single keyword-value\
  \n      list, suitable for TARGET-PARAMS argument for cgen-precompile and\
  \n      compile.  Currently the following keyword is recognized:\
  \n        :env-header-size  Size of environment frame header in words\
  \n        :cont-frame-size  Size of continuation frame in words.")
  (exit 0))

(define (split-to-symbols arg)
  (if arg
    ($ map string->symbol $ string-split arg #\,)
    '()))


(define (load-target-config file)
  (guard (e [(<read-error> e)
             (error "Invalid target-parameter file ~s: ~a" file (~ e'message))]
            [else
             (error "Can't read target-parameter file ~s" file)])
    (with-input-from-file file read)))

;; Local variables:
;; mode: scheme
;; end:
