#!/usr/bin/guile-@guile_version@ \
-e main -s
!#

;; Copyright (C) 2008-2018 Tommi Höynälänmaa
;; Distributed under GNU General Public License version 3,
;; see file doc/GPL-3.


;; *** Theme compiler main program ***


(import (th-scheme-utilities stdutils)
	(th-scheme-utilities hrecord)
	(th-scheme-utilities parse-command-line)
	(theme-d common theme-d-config)
	(theme-d translator theme-d-compiler))


(init-theme-d-config)

(define gl-theme-d-translator-dir
  (get-theme-d-config-var 'translator-dir))

(define gl-theme-d-lib-dir
  (get-theme-d-config-var 'lib-dir))


(define (main args)
  (let ((module-search-path0 "")
	(source-filename "")
	(target-filename "")
	(unit-type '())
	(message-level 1)
	(expand-only? #f)
	(no-expansion? #f)
	(backtrace? #f)
	(pretty-print? #f)
	(err-expr? #t)
	(show-modules? #f))
    (let* ((argd1 (make-hrecord <argument-descriptor> #\m #t
				(lambda (option-arg)
				  (set! module-search-path0 option-arg))))
	   (argd2 (make-hrecord <argument-descriptor> "module-path" #t
				(lambda (option-arg)
				  (set! module-search-path0 option-arg))))
	   (argd3 (make-hrecord <argument-descriptor> #\o #t
				(lambda (option-arg)
				  (set! target-filename option-arg))))
	   (argd4 (make-hrecord <argument-descriptor> "output" #t
				(lambda (option-arg)
				  (set! target-filename option-arg))))
	   (argd5 (make-hrecord <argument-descriptor> #\l #t
				(lambda (option-arg)
				  (set! message-level
					(string->number option-arg)))))
	   (argd6 (make-hrecord <argument-descriptor> "message-level" #t
				(lambda (option-arg)
				  (set! message-level
					(string->number option-arg)))))
	   (argd7 (make-hrecord <argument-descriptor> #\u #t
				(lambda (option-arg)
				  (set! unit-type
					(string->symbol option-arg)))))
	   (argd8 (make-hrecord <argument-descriptor> "unit-type" #t
				(lambda (option-arg)
				  (set! unit-type
					(string->symbol option-arg)))))
	   (argd9 (make-hrecord <argument-descriptor> "backtrace" #f
				(lambda ()
				  (set! backtrace? #t))))
	   (argd10 (make-hrecord <argument-descriptor> "pretty-print" #f
				 (lambda ()
				   (set! pretty-print? #t))))
	   (argd11 (make-hrecord <argument-descriptor> "no-verbose-errors" #f
				 (lambda ()
				   (set! err-expr? #f))))
	   (argd12 (make-hrecord <argument-descriptor> "show-modules" #f
				 (lambda ()
				   (set! show-modules? #t))))
	   (argd13 (make-hrecord <argument-descriptor> "expand-only" #f
				 (lambda ()
				   (set! expand-only? #t))))
	   (argd14 (make-hrecord <argument-descriptor> "no-expansion" #f
				 (lambda ()
				   (set! no-expansion? #t))))
	   (arg-descs (list argd1 argd2 argd3 argd4 argd5 argd6 argd7 argd8
			    argd9 argd10 argd11 argd12 argd13 argd14))
	   (args-without-cmd (cdr args))
	   (handle-proper-args (lambda (proper-args)
				 (if (= (length proper-args) 1)
				     (set! source-filename (car proper-args))
				     (raise 'command-line-syntax-error)))))
      (parse-command-line args-without-cmd arg-descs handle-proper-args)
      (if (not (or (null? unit-type)
		   (and (symbol? unit-type)
			(memq unit-type (list 'proper-program 'script
					      'interface 'body)))))
	  (raise 'invalid-unit-type))
      (set! gl-show-info? (not (= message-level 0)))

      (if (> message-level 0)
	  (set! debug-level (- message-level 1))
	  (set! debug-level 0))

      (let ((module-search-path
	     (if (string-null? module-search-path0)
		 (list gl-theme-d-lib-dir ".")
		 (parse-search-path module-search-path0 gl-theme-d-lib-dir))))
	(dw1 "source filename: ")
	(dwl1 source-filename)
	(dw1 "target filename (empty to use default): ")
	(dwl1 target-filename)
	(dw1 "module search path: ")
	(dwl1 module-search-path)
	(dw1 "unit type: ")
	(dwl1 unit-type)
	(dw1 "message level: ")
	(dwl1 message-level)
	(dw1 "expand only: ")
	(dwl1 (if expand-only? "yes" "no"))
	(dw1 "no expansion: ")
	(dwl1 (if no-expansion? "yes" "no"))
	(dw1 "backtrace: ")
	(dwl1 (if backtrace? "yes" "no"))
	(dw1 "display erroneous expression: ")
	(dwl1 (if err-expr? "yes" "no"))
	(dw1 "pretty printing: ")
	(dwl1 (if pretty-print? "yes" "no"))
	(dw1 "show module processing: ")
	(dwl1 (if show-modules? "yes" "no"))
	;; We assume that indented debug info is displayed only for
	;; module loading.
	(set! gl-show-indented-debug-info? show-modules?)
	(theme-compile-unit gl-compiler source-filename target-filename
			    unit-type module-search-path
			    expand-only? no-expansion?
			    backtrace? err-expr?
			    pretty-print?))))
  0)
