;; Generate a standalone C program from 
;; compiled Lush functions.
;; Yann LeCun, 10/2005

#? ** Making Standalone Executables
;; {<author> Yann LeCun}
;; Lush provides a rudimentary way to generate standalone
;; executable programs from a set of compiled Lush functions.


(libload "dh-compile")

;; lush_runtime.c contains functions that are used by compiled
;; functions, but are defined in lush/src files that have
;; other stuff in them. Eventually, we should remove those functions
;; from their current home and add lush_runtime.c to lush/src.
(defvar lushc_lush_runtime ())
(setq lushc_lush_runtime (concat (dirname file-being-loaded) "/lush_runtime.c"))

;; this is the list of include files that are needed
;; to compile C files generated by the Lush->C compiler.
(defvar lushc-includes ())
(setq lushc-includes
      '("define.h"
	"dh.h"
	"fltlib.h"
	"header.h"
	"idx.h"
	"idxmac.h"
	"idxops.h"
	"idxsquops.h"
	"check_func.h"
	"lushconf.h"
	"lushmake.h"))

;; get absolute paths to include files
(defvar lushc-includes ())
(setq lushc-includes  (all ((x lushc-includes)) (concat lushdir "/include/" x)))

(defvar lushc-libs ())
(setq lushc-libs "-lm -lc")

;; this is the list of files from the lush/src source tree
;; that we need to copy to the target directory.
(defvar lushc-cfiles ())
(setq lushc-cfiles '("check_func.c"))

;; turn this into absolute paths.
(setq lushc-cfiles (all ((x lushc-cfiles)) (concat lushdir "/src/" x)))

;; add the lush_runtime.c file to the list of cfiles.
(setq lushc-cfiles (cons lushc_lush_runtime lushc-cfiles))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

#? (make-standalone <lushfile> <cdir> <executable> <main-func>)
;; generate a standalone C program that contains all the
;; functions in lush file <lushfile>. All the necessary C source files
;; will be written in directory <cdir>. The directory will be created
;; if necessary. Generating the executable program can be done
;; by cd-ing to <cdir> and typing "make". The resulting executable 
;; file will be called <executable>.
;; The argument <main-func> is a string that indicates
;; the name of the Lush function that should become the "main" function
;; of the resulting C program. 
;;
;; This main function must be defined as:
;; {<code> 
;;   (de mymain (ac av) 
;;     ((-int-) ac) 
;;     ((-gptr- "char **") av) 
;;     ...body... 
;;     (to-int some-number))
;; 
;;   (dhc-make () mymain)
;; </code>}
; ; Let's say we have a file <test.lsh> in which the
;; function above is defined. We would do:
;; {<code> 
;;  (make-standalone "test.lsh" "cdir" "blah" "mymain")
;; </code>}
;; This will load <test.lsh>, compile the function, and 
;; write all the necessary C source files into the directory <cdir>.
;; The last argument indicates that the Lush function <mymain>
;; should be viewed as the main function of the C program.
;; If you leave it out, there will be no main function.
;; Then, you can cd to <cdir> and type "make".
;; This will produce an executable called <blah>.
;;
;; This is somewhat unfinished: the code doesn't get all the
;; dependency on libraries.
(de make-standalone (f dstdir executable main-func)
  (if (file-type dstdir)
      (when (<> 'dir (file-type dstdir)) (error "file exists"))
    (mkdir dstdir))
  (load f)
  (let* ((dep1 (lushc.get-c-dependencies f))
	 (deps (append dep1 lushc-cfiles lushc-includes)))
    (each ((d deps))
      (let* ((suffix (filename-get-suffix d))
	     (cfile (cond 
		     ((or (= "c" suffix) (= "h" suffix) (= "cc" suffix)) d)
		     (t (error "unknown file type"))))
	     ;; (libs lushc.get-lib-dependencies ())
	     )
	(if (not (= 'reg (file-type cfile)))
	    (printf "warning: C file %s does not exist\n" cfile)
	  (cp cfile (concat dstdir "/" (basename cfile))))))
    (let ((a ()))
      (writing (concat dstdir "/Makefile")
	(printf "CC = %s\n" (dhc-substitute-env "$CC"))
	(printf "LUSHFLAGS = %s %s\n" "-DNOLISP " (dhc-substitute-env dhc-make-lushflags))
	(printf "X_CFLAGS = %s\n" (dhc-substitute-env "$X_CFLAGS"))
	(printf "X_LIBS = %s\n" (dhc-substitute-env "$X_LIBS"))
	(printf "LIBS = -lm -lc\n")
	(printf "DEFS = %s\n" (dhc-substitute-env "$DEFS"))
	(printf "MAIN = -DC_%s=main\n" main-func)
	(printf "OBJS = ")
	(each ((d (append dep1 lushc-cfiles)))
	  (let* ((suffix (filename-get-suffix d)))
	    (when (= "c" suffix) (printf "%s.o " (filename-chop-suffix (basename d))))))
	(printf "\n")

	(printf "%s: ${OBJS}\n" executable)
	(printf "\t$(CC) -o %s ${OBJS} ${LIBS}\n" executable)

	(printf ".c.o:\n")
        (printf "\t${CC} ${MAIN} ${DEFS} ${X_CFLAGS} ${LUSHFLAGS} -c $<\n")
	))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
#? * low-level support functions for make-standalone


#? (lushc.lsh-to-c <fname>)
;; get the name of the .c file that corresponds to a .lsh file.
;; This does not check if the C file actually exists, it merely
;; returns its supposed path. This simply turns a string of the form
;; "blah/asd.lsh" into a string of the form "blah/C/asd.c".
(de lushc.lsh-to-c (fname)
  (concat (dirname fname) "/C/" 
	  (dhc-lisp-to-c-name (basename (filename-chop-suffixes fname))) 
	  "." (or (getconf "CEXT") "c")))


#? (lushc.o-to-c <oname>)
;; get the name of the compiler-generated .c file that corresponds to a 
;; .o file. This does not check if the .c file actually exists, it merely
;; returns its supposed path. This simply turns a string of the form
;; "blah/C/i686-pc-linux-gnu/asd.o" into a string of the form "blah/C/asd.c".
(de lushc.o-to-c (oname)
  (let* ((base (filename-chop-suffix (basename oname)))
	 (odir (dirname oname)))
    (when (<> (getconf "host") (basename odir))
      (error "strange directory for a compiler-generated .o file"))
    (concat (dirname odir) "/" base "." (or (getconf "CEXT") "c"))))

#? (lushc.c-to-o <cname>)
;; get the name of the .o file that corresponds to a 
;; compiler-generated .c file. 
;; This does not check if the files actually exist.
;; This simply turns a string of the form "blah/C/asd.c" 
;; into a string of the form "blah/C/i686-pc-linux-gnu/asd.o".
(de lushc.c-to-o (cname)
  (let* ((base (filename-chop-suffix (basename cname)))
	 (cdir (dirname cname)))
    (concat cdir "/" (getconf "host") "/" base "." (or (getconf "OBJEXT") "o"))))

#? (lushc.find-module <oname>)
;; return the module that corresponds to a .o file.
;; <oname> must be an absolute path.
;; The module must be mod-loaded beforehand.
;; This function returns nil if no suitable module is found.
(de lushc.find-module (oname)
  (let ((ml (module-list))
	(found ()))
    (while (and ml (not found))
      (prog1 
	  (when (= oname (module-filename (car ml)))
	    (setq found t) (car ml))
	(setq ml (cdr ml))))))

#? (lushc.get-parent-modules <themodule>)
;; get all the modules on which a module is directly dependent.
;; return them as a set (a htable).
(de lushc.get-parent-modules (themodule)
    (let ((ml (module-list))
	  (r ()))
      (each ((m ml))
	(when (and
	       ;; hack to get around bug of module-depends for .so
	       (<> (filename-get-suffix (module-filename m)) "so")
	       (member themodule (module-depends m)))
	  (setq r (cons m r))))
      (hset r)))


#? (lushc.get-ancestors-m <themodule>)
;; get all the modules on which a module is dependent,
;; directly or indirectly. Return the result as a set (a htable).
(de lushc.get-ancestors-m (themodule)
  (let ((parents (lushc.get-parent-modules themodule)))
    (when parents
      (each ((m (htable-keys parents)))
	  (hset-or parents (lushc.get-parent-modules m)))
      parents)))

;; get all the .o file on which a given .o depends
(de lushc.get-ancestors-o (ofile)
  (let* ((m (lushc.find-module ofile))
	 (m-ancestors (lushc.get-ancestors-m m)))
    (all ((x (htable-keys m-ancestors))) (module-filename x))))

;; get all the C files on which a given C file depends.
(de lushc.get-ancestors-c (cfile)
  (let* ((ofile (lushc.c-to-o cfile))
	 (o-ancestors (lushc.get-ancestors-o ofile)))
    (all ((x o-ancestors)) (lushc.o-to-c x))))

;; get all the C files on which a given lsh file depends.
(de lushc.get-c-dependencies (lshfile)
  (let ((cfile (concat-fname (lushc.lsh-to-c lshfile))))
    (lushc.get-ancestors-c cfile)))

;; get all the currently loaded libraries 
;; This is unfinished!!!!!
(de lushc.get-lib-dependencies ()
  (let* ((ml (module-list))
	 (r ()))
    (each ((m ml))
      (let* ((nam (module-filename m))
	     (s (filename-get-suffix n)))
	(when (and 
	       (<> (basename "lush"))
	       (or (not (module-unloadable-p m)) (= s "so") (= s "a")) 
	  (setq r (cons (module-filename m) r))))))
    r))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; OBSOLETE STUFF

;; get all the Lush source files on which a particular file depends.
;; What we should really do is figure out which C files a
;; lush file depends on.
(de lushc.get-lsh-dependencies (s)
  (let* ((f (libload.search s))
	 (dep (libload-dependencies f)))
    (if dep 
	(cons f (apply append (mapcar lushc.get-lsh-dependencies dep)))
      (list f))))

;; return the module corresponding to a .o file
(de lushc.o-to-module (o)
  (let ((m (module-list)) (stop ()))
    (while (and m (not stop))
      (prog1
	  (when (= o (module-filename (car m))) (setq stop t) m)
	(setq m (cdr m))))))

(de make-standalone-OBSOLETE (f dir &optional main-func)
  (if (file-type dir)
      (when (<> 'dir (file-type dir)) (error "file exists"))
    (mkdir dir))
  (libload f)
  (let ((deps (append (lushc.get-lsh-dependencies f) lushc-cfiles lushc-includes)))
    (each ((d deps))
      (let* ((suffix (filename-get-suffix d))
	     (cfile (cond 
		    ((= "lsh" suffix) (lushc.lsh-to-c d))
		    ((or (= "c" suffix) (= "h" suffix) (= "cc" suffix)) d)
		    (t (error "unknown file type")))))
	(if (not (= 'reg (file-type cfile))) 
	    (printf "warning: C file %s does not exist\n" cfile)
	  (cp cfile (concat dir "/" (basename cfile))))))))

