<commit_before>(in-package :php)

(defun must-enclose-in-braces (body check-if)
  "check if the body must be enclosed in braces, i.e. the body has more
than one member or the body is an 'if' or 'cond' and it is a part of an enclosing
if or cond"
  (assert (listp body))
  (or (cdr body) ;; more than one
      (and check-if
	   (listp (car body))
	   (find (caar body) '(if cond)))))

(defun remove-progn (body)
  (assert (listp body))
  (if (or (cdr body)
	  (not (eq 'progn (caar body))))
      body
      (remove-progn (cdar body))))

(defun remove-nested-progn (body)
  (assert (listp body))
  (loop for form in body
     append (if (progn-p form)
		(remove-nested-progn (cdr form))
		(list form))))
	 
(defun print-body (stream body &optional no-indent empty-semicolon)
  (let ((body (if (listp body) body (list body)))
	(*expect-statement* t))
      (unless no-indent (format stream "~8I~:@_"))
      (when (and empty-semicolon (null body))
	(write-string ";" stream))
      (format stream "~{~W~:[;~;~]~^ ~@:_~}"
	      (mapcan (lambda (form)
			(list form (no-semicolon-p form)))
		      body))
      (unless no-indent (format stream "~0I~:@_"))))

(defun ctl-body (stream body &optional check-if trailing-space)
  (let ((body (remove-progn (remove-nested-progn body))))
    (if (must-enclose-in-braces body check-if)
	(progn
	  (write-string " {" stream)
	  (print-body stream body)
	  (write-string "}" stream)
	  (if trailing-space
	      (write-string " " stream)))
	(print-body stream body nil t))))

(defun def-body (stream body &optional colon-p at-sign-p)
  (declare (ignore colon-p at-sign-p))
  (write-string "{" stream)
  (print-body stream body)
  (write-string "}" stream))

(defspecialform (while cond &rest body)
  (pprint-logical-block (stream nil)
    (fmt "while (~W)" cond)
    (ctl-body stream body)))

(defspecialform (for (&optional init cond step) &rest body)
  (let ((*expect-statement* nil))
    (pprint-logical-block (stream nil)
      (fmt "<for (~<~W; ~:_~W; ~:_~W~:>)~/php::ctl-body/"
	   (list init cond step) body))))

(defspecialform (cond &rest conditions)
  (flet ((clause (c &key initial else)
	   (destructuring-bind (cond &rest body)
	       c
	     (fmt "~:[~:[elseif~;if~] (~W)~;else~*~*~]" else initial cond)
	     (ctl-body stream body t t))))
    (pprint-logical-block (stream nil)
      (clause (first conditions) :initial t)
      (loop for c in (rest conditions)
	 do (clause c :else (eq-t-p (first c)))))))

(defspecialform (do-while while &rest body)
  (pprint-logical-block (stream nil)
    (fmt "do {")
    (print-body stream body)
    (fmt "} while (~W)" while)))

(defspecialform (foreach (array-expr binding) &rest body)
  (pprint-logical-block (stream nil)
    (if (consp binding)
	(fmt "foreach (~W as ~W => ~W)~/php::ctl-body/"
	     array-expr (first binding) (second binding) body)
	(fmt "foreach (~W as ~W)~/php::ctl-body/"
	     array-expr binding body))))

(defspecialform (foreach (array-expr binding) &rest body)
  (pprint-logical-block (stream nil)
    (write-string "foreach (" stream)
    (write array-expr :stream stream)
    (write-string " as " stream)    
    (if (consp binding)
	(progn (write (first binding) :stream stream)
	       (write-string " => " stream)
	       (write (second binding) :stream stream))
	(write binding :stream stream))
    (write-string ")" stream)
    (ctl-body stream body)))

(defspecialform (progn &rest body)
  (let ((body (remove-nested-progn body)))
    (if *expect-statement*
	(pprint-logical-block (stream nil)
	  (if *toplevel-progn*
	      (let ((*toplevel-progn*))
		(print-body stream body t))
	      (progn
		(write-string "{" stream)
		(print-body stream body)
		(write-string "}" stream))))
	(format stream "~{~W~^, ~}" body))))
					   <commit_msg>remove the redundant 'foreach' definition<commit_after>(in-package :php)

(defun must-enclose-in-braces (body check-if)
  "check if the body must be enclosed in braces, i.e. the body has more
than one member or the body is an 'if' or 'cond' and it is a part of an enclosing
if or cond"
  (assert (listp body))
  (or (cdr body) ;; more than one
      (and check-if
	   (listp (car body))
	   (find (caar body) '(if cond)))))

(defun remove-progn (body)
  (assert (listp body))
  (if (or (cdr body)
	  (not (eq 'progn (caar body))))
      body
      (remove-progn (cdar body))))

(defun remove-nested-progn (body)
  (assert (listp body))
  (loop for form in body
     append (if (progn-p form)
		(remove-nested-progn (cdr form))
		(list form))))
	 
(defun print-body (stream body &optional no-indent empty-semicolon)
  (let ((body (if (listp body) body (list body)))
	(*expect-statement* t))
      (unless no-indent (format stream "~8I~:@_"))
      (when (and empty-semicolon (null body))
	(write-string ";" stream))
      (format stream "~{~W~:[;~;~]~^ ~@:_~}"
	      (mapcan (lambda (form)
			(list form (no-semicolon-p form)))
		      body))
      (unless no-indent (format stream "~0I~:@_"))))

(defun ctl-body (stream body &optional check-if trailing-space)
  (let ((body (remove-progn (remove-nested-progn body))))
    (if (must-enclose-in-braces body check-if)
	(progn
	  (write-string " {" stream)
	  (print-body stream body)
	  (write-string "}" stream)
	  (if trailing-space
	      (write-string " " stream)))
	(print-body stream body nil t))))

(defun def-body (stream body &optional colon-p at-sign-p)
  (declare (ignore colon-p at-sign-p))
  (write-string "{" stream)
  (print-body stream body)
  (write-string "}" stream))

(defspecialform (while cond &rest body)
  (pprint-logical-block (stream nil)
    (fmt "while (~W)" cond)
    (ctl-body stream body)))

(defspecialform (for (&optional init cond step) &rest body)
  (let ((*expect-statement* nil))
    (pprint-logical-block (stream nil)
      (fmt "<for (~<~W; ~:_~W; ~:_~W~:>)~/php::ctl-body/"
	   (list init cond step) body))))

(defspecialform (cond &rest conditions)
  (flet ((clause (c &key initial else)
	   (destructuring-bind (cond &rest body)
	       c
	     (fmt "~:[~:[elseif~;if~] (~W)~;else~*~*~]" else initial cond)
	     (ctl-body stream body t t))))
    (pprint-logical-block (stream nil)
      (clause (first conditions) :initial t)
      (loop for c in (rest conditions)
	 do (clause c :else (eq-t-p (first c)))))))

(defspecialform (do-while while &rest body)
  (pprint-logical-block (stream nil)
    (fmt "do {")
    (print-body stream body)
    (fmt "} while (~W)" while)))

(defspecialform (foreach (array-expr binding) &rest body)
  (pprint-logical-block (stream nil)
    (if (consp binding)
	(fmt "foreach (~W as ~W => ~W)~/php::ctl-body/"
	     array-expr (first binding) (second binding) body)
	(fmt "foreach (~W as ~W)~/php::ctl-body/"
	     array-expr binding body))))

(defspecialform (progn &rest body)
  (let ((body (remove-nested-progn body)))
    (if *expect-statement*
	(pprint-logical-block (stream nil)
	  (if *toplevel-progn*
	      (let ((*toplevel-progn*))
		(print-body stream body t))
	      (progn
		(write-string "{" stream)
		(print-body stream body)
		(write-string "}" stream))))
	(format stream "~{~W~^, ~}" body))))
					   
{'fraction_non_alphanumeric': 0.17304445694991558, 'fraction_numerical': 0.0005627462014631402, 'mean_word_length': 3.3294762484774667, 'pattern_counts': {'":': 0, '<': 7, '<?xml version=': 0, '>': 8, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '7176840', 'n_tokens_mistral': 2665, 'n_tokens_neox': 2536, 'n_words': 776}