<commit_before>;; This software is Copyright (c) 2012 <NAME>
;; (techsnuffle<at>gmail<dot>com)
;; <NAME> grants you the rights to
;; distribute and use this software as governed
;; by the terms of the Lisp Lesser GNU Public License
;; (http://opensource.franz.com/preamble.html),
;; known as the LLGPL.

;; Functions and macros for handling time in games
;; This area is very prone to change as time is so integral
;; to game building.

(in-package :base-time)

;; -----------------------------------------------------------------------------
;; + tlambda is the top level and triggers the expire signal
;;
;; + tprogn has given back one progn with multiple if forms, one for
;;   each step. It also returns the expire-test that check that they have all
;;   expired
;;
;; + mapcar %process-tprogn-form either calls %compile-time-cond-form, handles the
;;   time-special-forms or if it is a lisp statement, returns it correctly.
;;
;; + time-syntax-expand takes a form and calls the function named by the first
;;   item in the form (in the time-syntax package). IT passes the rest of the
;;   form as args to that function
;;
;; + %compile-time-cond-form takes a form in the format ((condition) &rest body)
;;   and returns the result in the correct format for other functions to use.
;;   It does not wrap in if statements or handle any of the expiry as that
;;   should be done by the special forms (or the tlambda root form)
;;
;; + ~time-syntax~ these functions return a list of data in the following order:
;;   code, expired-test, local-vars, closed-vars
;; -----------------------------------------------------------------------------

;; {TODO} can use func-name for block if tdefun
(defun gen-time-function-body (name args body)
  (with-t-obj () (tprogn body)
    (let ((lbody (if expired-test
                     `(if ,expired-test
                          (cfunc:signal-expired)
                          ,code)
                     code)))
      `(let (,@(loop :for (a b) :in closed-vars
                  :collect (list a b)))
         (,@(if name `(defun ,name) '(lambda)) ,args            
            (block tlambda-implicit-block
              (tagbody tlambda-start
                 (return-from tlambda-implicit-block
                   (let ,local-vars
                     ,lbody)))))))))

(defmacro tdefun (name args &body body) (gen-time-function-body name args body))
(defmacro tlambda (args &body body) (gen-time-function-body nil args body))

;;------------------------------------
;; Time compiler internals
;;------------------------------------

(defun %process-tprogn-form (form)
  (if (atom form) ;; if lisp literal then it is fine
      (make-instance 'tcompile-obj :code form :run-test t)
      (case (first form) ;; handler special forms and t-syntax
        (repeat (tthen/repeat (rest form) :repeat t))
        (then (tthen/repeat (rest form) :repeat nil))
        (progn (tprogn (rest form)))
        (otherwise (%process-tform form)))))

(defun %process-tform (form)
  (if (or (atom (first form))
          (and (listp (first form)) (eq (caar form) 'lambda)))
      (make-instance 'tcompile-obj :code form :run-test t)
      (%compile-time-cond-form form)))

(defun time-syntaxp (name)
  (symbol-function (symbolicate-package :time-syntax name)))
(defun time-syntax-expand (form)
  (let ((name (first form))
        (rest (rest form)))
    (apply (symbol-function (symbolicate-package :time-syntax name)) rest)))

;;{TODO} signal a exception and catch it higer up so we can get the original form
(defun t-chain-expand (counter forms &optional accum)
  (loop :for form :in forms :if (null (first form)) 
     :do (error "CEPL: The following time form does not expire and thus~% this chain of forms can never progress:~%~%~a" form))
  (loop :for (expire-test run-test code initialize-next local-vars)
     :in (reverse forms):for i :from (1- (length forms)) :downto 0 :do
     (setf accum `(let ,local-vars
                    (if ,expire-test
                        (progn (when (= ,counter ,i) ,@initialize-next) ,accum)
                        (when ,run-test ,code))))
     :finally (return accum)))

(defun %compile-time-cond-form (form)
  (if (atom form)
      (make-instance 'tcompile-obj :code form)
      (let* ((condition-form (first form))
             (expanded-form (time-syntax-expand condition-form))
             (compiled-body (tprogn (rest form))))
        (destructuring-bind
              (&optional run-test expired-test local-vars closed-vars override)
            expanded-form
          (make-instance
           'tcompile-obj
           :code (t-code compiled-body)
           :run-test run-test
           :expired-test (if (symbolp expired-test)
                             (when (t-expired-test compiled-body)
                               (cons expired-test (t-expired-test compiled-body)))
                             expired-test) 
           ;; {TODO} Here we essentially throw away the expiry
           ;; tests of the other forms...seems dumb
           :local-vars local-vars
           :closed-vars (append closed-vars (t-closed-vars compiled-body))
           :override override)))))

;;------------------------------------
;; Time compiler special forms
;;------------------------------------

(defmacro then (&body temporal-statements)
  (declare (ignore temporal-statements))
  (error "'Then' can only be used inside a tlambda*"))
(defmacro repeat (&body temporal-statements)
  (declare (ignore temporal-statements))
  (error "'Repeat' can only be used inside a tlambda*"))

(defun tprogn (forms)
  (let* ((processed-forms (mapcar #'%process-tprogn-form forms))
         (let-forms (remove nil (mapcan #'t-local-vars processed-forms))))
    (make-instance
     'tcompile-obj
     :code `(progn
              ,@(loop :for form :in processed-forms :collect
                   (with-t-obj () form
                     (if (and (eq run-test t) (null expired-test))
                         code
                         `(when (and (not ,expired-test) ,run-test)
                            ,code))))) ;; this should be an if
     :local-vars let-forms
     :run-test t
     :expired-test (let ((expire-forms
                          (remove nil (mapcar #'t-expired-test processed-forms))))
                     (when expire-forms `(and ,@expire-forms)))
     :closed-vars (remove nil (mapcan #'t-closed-vars processed-forms)))))

(defun tthen/repeat (forms &key repeat)
  (unless (null forms)
    (let* ((processed-forms (mapcar #'%process-tprogn-form forms))
           (counter-sym (gensym "counter"))
           (%closed-vars (remove nil (mapcan #'t-closed-vars processed-forms)))           
           (chain-forms
            (loop :for form :in processed-forms :for index :from 0
               :collect
               (with-t-obj () form
                 (if repeat
                     (list expired-test
                           run-test
                           code
                           (if (= index (1- (length forms)))
                               `((setf ,counter-sym 0)                                 
                                 ,@(loop :for i :in (t-closed-vars (first processed-forms))
                                      :if (and override (third i))<commit_msg>Just made a commit to tprogn that was dependent on being the root progn....but this seems crazy as they should all be the same. Commiting this before my next change so I can revert if I'm wrong<commit_after>;; This software is Copyright (c) 2012 <NAME>
;; (techsnuffle<at>gmail<dot>com)
;; <NAME> grants you the rights to
;; distribute and use this software as governed
;; by the terms of the Lisp Lesser GNU Public License
;; (http://opensource.franz.com/preamble.html),
;; known as the LLGPL.

;; Functions and macros for handling time in games
;; This area is very prone to change as time is so integral
;; to game building.

(in-package :base-time)

;; -----------------------------------------------------------------------------
;; + tlambda is the top level and triggers the expire signal
;;
;; + tprogn has given back one progn with multiple if forms, one for
;;   each step. It also returns the expire-test that check that they have all
;;   expired
;;
;; + mapcar %process-tprogn-form either calls %compile-time-cond-form, handles the
;;   time-special-forms or if it is a lisp statement, returns it correctly.
;;
;; + time-syntax-expand takes a form and calls the function named by the first
;;   item in the form (in the time-syntax package). IT passes the rest of the
;;   form as args to that function
;;
;; + %compile-time-cond-form takes a form in the format ((condition) &rest body)
;;   and returns the result in the correct format for other functions to use.
;;   It does not wrap in if statements or handle any of the expiry as that
;;   should be done by the special forms (or the tlambda root form)
;;
;; + ~time-syntax~ these functions return a list of data in the following order:
;;   code, expired-test, local-vars, closed-vars
;; -----------------------------------------------------------------------------

;; {TODO} can use func-name for block if tdefun
(defun gen-time-function-body (name args body)
  (with-t-obj () (tprogn body t)
    (let ((lbody (if expired-test
                     `(if ,expired-test
                          (cfunc:signal-expired)
                          ,code)
                     code)))
      `(let (,@(loop :for (a b) :in closed-vars
                  :collect (list a b)))
         (,@(if name `(defun ,name) '(lambda)) ,args            
            (block tlambda-implicit-block
              (tagbody tlambda-start
                 (return-from tlambda-implicit-block
                   ,lbody))))))))

(defmacro tdefun (name args &body body) (gen-time-function-body name args body))
(defmacro tlambda (args &body body) (gen-time-function-body nil args body))

;;------------------------------------
;; Time compiler internals
;;------------------------------------

(defun %process-tprogn-form (form)
  (if (atom form) ;; if lisp literal then it is fine
      (make-instance 'tcompile-obj :code form :run-test t)
      (case (first form) ;; handler special forms and t-syntax
        (repeat (tthen/repeat (rest form) :repeat t))
        (then (tthen/repeat (rest form) :repeat nil))
        (progn (tprogn (rest form)))
        (otherwise (%process-tform form)))))

(defun %process-tform (form)
  (if (or (atom (first form))
          (and (listp (first form)) (eq (caar form) 'lambda)))
      (make-instance 'tcompile-obj :code form :run-test t)
      (%compile-time-cond-form form)))

(defun time-syntaxp (name)
  (symbol-function (symbolicate-package :time-syntax name)))
(defun time-syntax-expand (form)
  (let ((name (first form))
        (rest (rest form)))
    (apply (symbol-function (symbolicate-package :time-syntax name)) rest)))

;;{TODO} signal a exception and catch it higer up so we can get the original form
(defun t-chain-expand (counter forms &optional accum)
  (loop :for form :in forms :if (null (first form)) 
     :do (error "CEPL: The following time form does not expire and thus~% this chain of forms can never progress:~%~%~a" form))
  (loop :for (expire-test run-test code initialize-next local-vars)
     :in (reverse forms):for i :from (1- (length forms)) :downto 0 :do
     (setf accum `(let ,local-vars
                    (if ,expire-test
                        (progn (when (= ,counter ,i) ,@initialize-next) ,accum)
                        (when ,run-test ,code))))
     :finally (return accum)))

(defun %compile-time-cond-form (form)
  (if (atom form)
      (make-instance 'tcompile-obj :code form)
      (let* ((condition-form (first form))
             (expanded-form (time-syntax-expand condition-form))
             (compiled-body (tprogn (rest form))))
        (destructuring-bind
              (&optional run-test expired-test local-vars closed-vars override)
            expanded-form
          (make-instance
           'tcompile-obj
           :code (t-code compiled-body)
           :run-test run-test
           :expired-test (if (symbolp expired-test)
                             (when (t-expired-test compiled-body)
                               (cons expired-test (t-expired-test compiled-body)))
                             expired-test) 
           ;; {TODO} Here we essentially throw away the expiry
           ;; tests of the other forms...seems dumb
           :local-vars local-vars
           :closed-vars (append closed-vars (t-closed-vars compiled-body))
           :override override)))))

;;------------------------------------
;; Time compiler special forms
;;------------------------------------

(defmacro then (&body temporal-statements)
  (declare (ignore temporal-statements))
  (error "'Then' can only be used inside a tlambda*"))
(defmacro repeat (&body temporal-statements)
  (declare (ignore temporal-statements))
  (error "'Repeat' can only be used inside a tlambda*"))

(defun tprogn (forms &optional rootp)
  (let* ((processed-forms (mapcar #'%process-tprogn-form forms))
         (let-forms (if rootp
                        (mapcar #'t-local-vars processed-forms)
                        (remove nil (mapcan #'t-local-vars processed-forms)))))
    (make-instance
     'tcompile-obj
     :code `(progn
              ,@(loop :for form :in processed-forms :collect
                   (with-t-obj () form
                     (if (and (eq run-test t) (null expired-test))
                         code
                         `(when (and (not ,expired-test) ,run-test)
                            ,code))))) ;; this should be an if
     :local-vars let-forms
     :run-test t
     :expired-test (let ((expire-forms (mapcar #'t-expired-test processed-forms)))
                     (when (every #'identity expire-forms)
                       `(and ,@expire-forms)))
     :closed-vars (remove nil (mapcan #'t-closed-vars processed-forms)))))

(defun tthen/repeat (forms &key repeat)
  (unless (null forms)
    (let* ((processed-forms (mapcar #'%process-tprogn-form forms))
           (counter-sym (gensym "counter"))
           (%closed-vars (remove nil (mapcan #'t-closed-vars processed-forms)))           
           (chain-forms
            (loop :for form :in processed-forms :for index :from 0
               :collect
               (with-t-obj () form
                 (if repeat
                     (list expired-test
                           run-test
                           code
                           (if (= index (1- (length forms)))
                               `((setf ,counter-sym 0)                                 
                                 ,@(loop :for i :in (t-closed-vars (first processed-forms))
                                      :if (and override (third i))
{'fraction_non_alphanumeric': 0.15554806070826308, 'fraction_numerical': 0.0012141652613827994, 'mean_word_length': 1.883313885647608, 'pattern_counts': {'":': 0, '<': 11, '<?xml version=': 0, '>': 11, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 8, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '6570675', 'n_tokens_mistral': 4206, 'n_tokens_neox': 4048, 'n_words': 1445}