metal-compiler.lisp

;;;; metal/compiler.lisp
;;;;
;;;; Copyright (c) 2015 Adrian Medina

(in-package :metal)

(defparameter *metal-source-paths*
  (asdf:system-relative-pathname *system* "src/metal/"))

(defun metal (pathname)
  "Compiles a single metal source file into an .air file."
  (let ((output (create-temp-file :file-type "air")))
    (multiple-value-bind (status error-output)
	(sys:call-system-showing-output (format nil "metal -arch air64 -emit-llvm -c -gline-tables-only -ffast-math -I~A -mmacosx-version-min=10.11 -std=osx-metal1.1 -o ~A ~A" *metal-source-paths* output pathname)
					:show-cmd nil
					:output-stream nil)
      (if (zerop status)
	  output
	  (restart-case (error error-output)
	    (recompile-file ()
	      :report (lambda (stream)
			(format stream "Recompile metal source file."))
	      (metal pathname)))))))

(defun metal-ar (pathnames)
  "Compile .air files into a single .metal-ar archive."
  (let ((output (create-temp-file :file-type "metal-ar")))
    (delete-file output)
    (sys:call-system (format nil "metal-ar r ~A ~{~A ~}" output pathnames))
    output))

(defun metallib (pathname)
  "Compile .metal-ar file into .metallib library."
  (let ((output (create-temp-file :file-type "metallib")))
    (delete-file output)
    (sys:call-system (format nil "metallib -o ~A ~A" output pathname))
    output))

(defun compile-metallib-for-system ()
  (let* ((srcs (directory (merge-pathnames "*.metal" *metal-source-paths*)))
	 (airs (loop
		 for src in srcs
		 collect (metal src)))
	 (metal-ar (metal-ar airs)))
    (metallib metal-ar)))

(defun compile-metal-library (device)
  (fli:with-dynamic-foreign-objects ((error objc:objc-object-pointer))
    (let* ((path (namestring (compile-metallib-for-system)))
	   (lib (objc:invoke device "newLibraryWithFile:error:" path error)))
      (unless (fli:null-pointer-p (fli:dereference error))
	(restart-case (error (objc:invoke-into 'string
					       (fli:dereference error)
					       "localizedDescription"))
	  (recompile-library ()
	    :report (lambda (stream)
		      (format stream "Recompile library."))
	    (compile-metal-library device))))
      lib)))