<commit_before>;;;; This file translates s-expressions to GLSL shader strings so that
;;;; shaders can be embedded directly within the source code of the
;;;; file.

(in-package #:cl-foo)

(defun make-glsl-binary-operation (symbol first-elt rest-elt)
  (ecase symbol
    ((+) (format nil "(~A~{ + ~A~})" first-elt rest-elt))
    ((-) (format nil "(~A~{ - ~A~})" first-elt rest-elt))
    ((*) (format nil "(~A~{ * ~A~})" first-elt rest-elt))
    ((/) (format nil "(~A~{ / ~A~})" first-elt rest-elt))
    ((>) (format nil "(~A~{ > ~A~})" first-elt rest-elt))
    ((<) (format nil "(~A~{ < ~A~})" first-elt rest-elt))
    ((>=) (format nil "(~A~{ >= ~A~})" first-elt rest-elt))
    ((<=) (format nil "(~A~{ <= ~A~})" first-elt rest-elt))
    ((and) (format nil "(~A~{ && ~A~})" first-elt rest-elt))
    ((or) (format nil "(~A~{ || ~A~})" first-elt rest-elt))))

(defun make-glsl-unary-operation (symbol first-elt)
  (ecase symbol
    ((not) (format nil "!(~A)" first-elt))
    ((-) (format nil "-(~A)" first-elt))))

(defun make-glsl-operation (symbol l)
  (let ((first-elt (first l))
        (rest-elt (rest l)))
    (ecase symbol
      ((+ * / > < >= <= and or) (make-glsl-binary-operation symbol first-elt rest-elt))
      ((not) (make-glsl-unary-operation symbol first-elt))
      ((-) (if (eq (length rest-elt) 0)
               (make-glsl-unary-operation symbol first-elt)
               (make-glsl-binary-operation symbol first-elt rest-elt))))))

(defun make-glsl-line (l)
  (let ((symbol (elt l 0)))
    (case symbol
      ((version) (format nil "#version ~D~%~%" (elt l 1)))
      ((in) (format nil "in ~A ~A;~%" (elt l 1) (elt l 2)))
      ((out) (format nil "out ~A ~A;~%" (elt l 1) (elt l 2)))
      ((in-location) (format nil "layout(location = ~D) in ~A ~A;~%" (elt l 1) (elt l 2) (elt l 3)))
      ((out-location) (format nil "layout(location = ~D) out ~A ~A;~%" (elt l 1) (elt l 2) (elt l 3)))
      ((uniform) (format nil "uniform ~A ~A;~%" (elt l 1) (elt l 2)))
      (otherwise (make-glsl-operation symbol (rest l))))))

;;; FIXME: At the moment doesn't take arguments and doesn't return things.
;;; FIXME: At the moment only takes in one line.
;;; FIXME: At the moment just takes in a GLSL string line, not a list.
(defun make-glsl-function (name line)
  (concatenate 'string
               (format nil "void ~A(void)~%{~%  " name)
               line
               (format nil "~%}")))

(defun read-shader (shader-string shader-type)
  (let ((shader (gl:create-shader shader-type)))
    (gl:shader-source shader shader-string)
    (gl:compile-shader shader)
    (if (not (gl:get-shader shader :compile-status))
        (error (concatenate 'string "Error in compiling shader~%" (gl:get-shader-info-log shader))))
    shader))

(defun shader-program (shaders)
  (let ((program (gl:create-program)))
    (map nil #'(lambda (shader) (gl:attach-shader program shader)) shaders)
    (gl:link-program program)
    (if (not (gl:get-program program :link-status))
        (error (concatenate 'string "Error in shader program~%" (gl:get-program-info-log program))))
    (map nil #'(lambda (shader) (gl:detach-shader program shader)) shaders)
    program))

(defmacro with-shaders ((shaders program &key shader-list shader-type-list) &body body)
  ;; FIXME: Assumes that all of the given shaders are used in the same
  ;; program.
  `(let* ((,shaders (mapcar #'read-shader ,shader-list ,shader-type-list))
          (,program (shader-program ,shaders)))
     (unwind-protect
          (progn ,@body)
       (progn
         (map nil #'gl:delete-shader ,shaders)
         (gl:delete-program ,program)))))

(defun make-glsl-shader (l)
  (map 'list #'(lambda (x) (cond ((typep x 'list) (make-glsl-line x))
                                 ((typep x 'string) (format nil "~S" x))
                                 ((typep x 'number) (format nil "~A" x))))
       l))
<commit_msg>Make the shader output be a string.<commit_after>;;;; This file translates s-expressions to GLSL shader strings so that
;;;; shaders can be embedded directly within the source code of the
;;;; file.

(in-package #:cl-foo)

(defun make-glsl-binary-operation (symbol first-elt rest-elt)
  (ecase symbol
    ((+) (format nil "(~A~{ + ~A~})" first-elt rest-elt))
    ((-) (format nil "(~A~{ - ~A~})" first-elt rest-elt))
    ((*) (format nil "(~A~{ * ~A~})" first-elt rest-elt))
    ((/) (format nil "(~A~{ / ~A~})" first-elt rest-elt))
    ((>) (format nil "(~A~{ > ~A~})" first-elt rest-elt))
    ((<) (format nil "(~A~{ < ~A~})" first-elt rest-elt))
    ((>=) (format nil "(~A~{ >= ~A~})" first-elt rest-elt))
    ((<=) (format nil "(~A~{ <= ~A~})" first-elt rest-elt))
    ((and) (format nil "(~A~{ && ~A~})" first-elt rest-elt))
    ((or) (format nil "(~A~{ || ~A~})" first-elt rest-elt))))

(defun make-glsl-unary-operation (symbol first-elt)
  (ecase symbol
    ((not) (format nil "!(~A)" first-elt))
    ((-) (format nil "-(~A)" first-elt))))

(defun make-glsl-operation (symbol l)
  (let ((first-elt (first l))
        (rest-elt (rest l)))
    (ecase symbol
      ((+ * / > < >= <= and or) (make-glsl-binary-operation symbol first-elt rest-elt))
      ((not) (make-glsl-unary-operation symbol first-elt))
      ((-) (if (eq (length rest-elt) 0)
               (make-glsl-unary-operation symbol first-elt)
               (make-glsl-binary-operation symbol first-elt rest-elt))))))

(defun make-glsl-line (l)
  (let ((symbol (elt l 0)))
    (case symbol
      ((version) (format nil "#version ~D~%~%" (elt l 1)))
      ((in) (format nil "in ~A ~A;~%" (elt l 1) (elt l 2)))
      ((out) (format nil "out ~A ~A;~%" (elt l 1) (elt l 2)))
      ((in-location) (format nil "layout(location = ~D) in ~A ~A;~%" (elt l 1) (elt l 2) (elt l 3)))
      ((out-location) (format nil "layout(location = ~D) out ~A ~A;~%" (elt l 1) (elt l 2) (elt l 3)))
      ((uniform) (format nil "uniform ~A ~A;~%" (elt l 1) (elt l 2)))
      (otherwise (make-glsl-operation symbol (rest l))))))

;;; FIXME: At the moment doesn't take arguments and doesn't return things.
;;; FIXME: At the moment only takes in one line.
;;; FIXME: At the moment just takes in a GLSL string line, not a list.
(defun make-glsl-function (name line)
  (concatenate 'string
               (format nil "void ~A(void)~%{~%  " name)
               line
               (format nil "~%}")))

(defun read-shader (shader-string shader-type)
  (let ((shader (gl:create-shader shader-type)))
    (gl:shader-source shader shader-string)
    (gl:compile-shader shader)
    (if (not (gl:get-shader shader :compile-status))
        (error (concatenate 'string "Error in compiling shader~%" (gl:get-shader-info-log shader))))
    shader))

(defun shader-program (shaders)
  (let ((program (gl:create-program)))
    (map nil #'(lambda (shader) (gl:attach-shader program shader)) shaders)
    (gl:link-program program)
    (if (not (gl:get-program program :link-status))
        (error (concatenate 'string "Error in shader program~%" (gl:get-program-info-log program))))
    (map nil #'(lambda (shader) (gl:detach-shader program shader)) shaders)
    program))

(defmacro with-shaders ((shaders program &key shader-list shader-type-list) &body body)
  ;; FIXME: Assumes that all of the given shaders are used in the same
  ;; program.
  `(let* ((,shaders (mapcar #'read-shader ,shader-list ,shader-type-list))
          (,program (shader-program ,shaders)))
     (unwind-protect
          (progn ,@body)
       (progn
         (map nil #'gl:delete-shader ,shaders)
         (gl:delete-program ,program)))))

(defun make-glsl-shader (l)
  (format nil "~{~A~}" (map 'list #'(lambda (x) (cond ((typep x 'list) (make-glsl-line x))
                                                      ((typep x 'string) (format nil "~S" x))
                                                      ((typep x 'number) (format nil "~A" x))))
                            l)))

{'fraction_non_alphanumeric': 0.19641722779824672, 'fraction_numerical': 0.003811459789099225, 'mean_word_length': 2.855044074436827, 'pattern_counts': {'":': 0, '<': 15, '<?xml version=': 0, '>': 15, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 6, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '5577393', 'n_tokens_mistral': 2823, 'n_tokens_neox': 2758, 'n_words': 853}