<commit_before>;;;;; TRE tree processor transpiler
;;;;; Copyright (c) 2008 <NAME> <<EMAIL>>

;;;; OPERATOR EXPANSION

(defmacro define-transpiler-infix (tr name)
  `(define-expander-macro ',(transpiler-macro-expander (eval tr)) ,name (x y)
	 `(%transpiler-native ,,x ,(string-downcase (string name)) " " ,,y)))

(defun transpiler-binary-expand (op args)
  (nconc (mapcan #'(lambda (x)
					 `(,x ,op))
				 (butlast args))
		 (last args)))

(defmacro define-transpiler-binary (tr op repl-op)
  `(define-expander-macro ',(transpiler-macro-expander (eval tr)) ,op (&rest args)
     `("(" ,,@(transpiler-binary-expand ,repl-op args) ")")))

;;;; ENCAPSULATION

(defun transpiler-encapsulate-strings (x)
  (if (atom x)
      (if (stringp x)
          (list '%transpiler-string x)
		  x)
	  (if (eq '%transpiler-native (car x))
		  x
		  (cons (transpiler-encapsulate-strings (car x))
		  		(transpiler-encapsulate-strings (cdr x))))))

;;;; EXPRESSION FINALIZATION

;; Add separators.
;;   Separators cannot be added later, because the expression bounds will
;;   disappear when everything is expanded to target-language strings in
;;   the next pass.
;; Make jump labels.
;; Remove (IDENTITY ~%RET)  expressions.
;; Add %VAR declarations for expex symbols.
(defun transpiler-finalize-sexprs (tr x)
  (when x
	(with (a          (car x)
		   separator  (transpiler-separator tr)
		   ret (transpiler-obfuscate tr '~%ret))
	  (if (eq a nil) ; ???
		  (transpiler-finalize-sexprs tr (cdr x))
	  	  (if (atom a) 
			  ; Make jump label.
		      (cons (funcall (transpiler-make-label tr) a)
		            (transpiler-finalize-sexprs tr (cdr x)))
              (if (and (%setq? a)
					   (is-lambda? (%setq-value a)))
			  	  ; Recurse into function.
	              (cons `(%var (%setq ,(%setq-place a)
										   ,(copy-recurse-into-lambda (%setq-value a)
										        #'((body)(transpiler-finalize-sexprs tr body)))))
			            (cons separator
						      (transpiler-finalize-sexprs tr (cdr x))))
	              (if (and (identity? a) (eq ret (second a)))
				  	  ; Ignore (IDENTITY ~%RET).
		              (transpiler-finalize-sexprs tr (cdr x))
				      ; Just copy with separator. Make return-value assignment if missing.
		              (cons (if (not (or (vm-jump? a)
									 	 (%setq? a)
									 	 (in? (car a) '%var '%transpiler-native)))
							    `(%setq ,ret ,a)
								; Add %VAR declaration for EXPEX symbols.
							    (if (and (%setq? a)
										 (expex-sym? (%setq-place a)))
									`(%var ,a)
									a))
						    (cons separator
							      (transpiler-finalize-sexprs tr (cdr x)))))))))))

;;;; TRANSPILER-MACRO EXPANDER
;;;;
;;;; Expands code-generating macros and converts expressions to C-style function calls.

;; Returns T for every %SETQ expression assigning the value of a function call.
(defun transpiler-macrop-funcall? (x)
  (and (consp x)
	   (%setq? x)
	   (consp (%setq-value x))
	   (not (stringp (first (%setq-value x))))
	   (not (in? (first (%setq-value x)) '%transpiler-string '%transpiler-native))))

(defun transpiler-macrocall-funcall (x)
  `("(" ,@(transpiler-binary-expand "," x) ")"))

(defun transpiler-macrocall (tr fun x)
  (with (m (cdr (assoc fun
					   (expander-macros (expander-get (transpiler-macro-expander tr))))))
    (if m
        (with (e (apply m x))
	       (if (transpiler-macrop-funcall? `(,fun ,@x))
				; Make C-style function call.
  		       `(,(first e) ,(second e) ,(first (third e)) ,@(transpiler-macrocall-funcall (cdr (third e))))
		       e))
		`(,fun ,@x))))

(defmacro define-transpiler-macro (tr name args body)
  `(define-expander-macro ',(transpiler-macro-expander (eval tr)) ,name ,args ,body))

;;;; POST PROCESSING<commit_msg>Clean-up.<commit_after>;;;;; TRE tree processor transpiler
;;;;; Copyright (c) 2008 <NAME> <<EMAIL>>

;;;; OPERATOR EXPANSION

(defmacro define-transpiler-infix (tr name)
  `(define-expander-macro ',(transpiler-macro-expander (eval tr)) ,name (x y)
	 `(%transpiler-native ,,x ,(string-downcase (string name)) " " ,,y)))

(defun transpiler-binary-expand (op args)
  (nconc (mapcan #'(lambda (x)
					 `(,x ,op))
				 (butlast args))
		 (last args)))

(defmacro define-transpiler-binary (tr op repl-op)
  `(define-expander-macro ',(transpiler-macro-expander (eval tr)) ,op (&rest args)
     `("(" ,,@(transpiler-binary-expand ,repl-op args) ")")))

;;;; ENCAPSULATION

(defun transpiler-encapsulate-strings (x)
  (if (atom x)
      (if (stringp x)
          (list '%transpiler-string x)
		  x)
	  (if (eq '%transpiler-native (car x))
		  x
		  (cons (transpiler-encapsulate-strings (car x))
		  		(transpiler-encapsulate-strings (cdr x))))))

;;;; EXPRESSION FINALIZATION

;; Add separators.
;;   Separators cannot be added later, because the expression bounds will
;;   disappear when everything is expanded to target-language strings in
;;   the next pass.
;; Make jump labels.
;; Remove (IDENTITY ~%RET)  expressions.
;; Add %VAR declarations for expex symbols.
(defun transpiler-finalize-sexprs (tr x)
  (when x
	(with (a          (car x)
		   separator  (transpiler-separator tr)
		   ret (transpiler-obfuscate tr '~%ret))
	  (cond
		((eq a nil) ; ???
		   (transpiler-finalize-sexprs tr (cdr x)))

	  	((atom a) 
		   ; Make jump label.
		   (cons (funcall (transpiler-make-label tr) a)
		         (transpiler-finalize-sexprs tr (cdr x))))

        ((and (%setq? a)
			  (is-lambda? (%setq-value a)))
		   ; Recurse into function.
	       (cons `(%setq ,(%setq-place a)
				    ,(copy-recurse-into-lambda
					   (%setq-value a)
					   #'((body)
						    (transpiler-finalize-sexprs tr body))))
			     (cons separator
				       (transpiler-finalize-sexprs tr (cdr x)))))

	    ((and (identity? a)
			  (eq ret (second a)))
		   ; Ignore (IDENTITY ~%RET).
		   (transpiler-finalize-sexprs tr (cdr x)))

	    (t ; Just copy with separator. Make return-value assignment if missing.
		   (cons (if (or (vm-jump? a)
						 (%setq? a)
						 (in? (car a) '%var '%transpiler-native))
					 a
					 `(%setq ,ret ,a))
				 (cons separator
				       (transpiler-finalize-sexprs tr (cdr x)))))))))

;;;; TRANSPILER-MACRO EXPANDER
;;;;
;;;; Expands code-generating macros and converts expressions to C-style function calls.

;; Returns T for every %SETQ expression assigning the value of a function call.
(defun transpiler-macrop-funcall? (x)
  (and (consp x)
	   (%setq? x)
	   (consp (%setq-value x))
	   (not (stringp (first (%setq-value x))))
	   (not (in? (first (%setq-value x)) '%transpiler-string '%transpiler-native))))

(defun transpiler-macrocall-funcall (x)
  `("(" ,@(transpiler-binary-expand "," x) ")"))

(defun transpiler-macrocall (tr fun x)
  (with (m (cdr (assoc fun
					   (expander-macros (expander-get (transpiler-macro-expander tr))))))
    (if m
        (with (e (apply m x))
	       (if (transpiler-macrop-funcall? `(,fun ,@x))
				; Make C-style function call.
  		       `(,(first e) ,(second e) ,(first (third e)) ,@(transpiler-macrocall-funcall (cdr (third e))))
		       e))
		`(,fun ,@x))))

(defmacro define-transpiler-macro (tr name args body)
  `(define-expander-macro ',(transpiler-macro-expander (eval tr)) ,name ,args ,body))

;;;; POST PROCESSING
{'fraction_non_alphanumeric': 0.16601941747572815, 'fraction_numerical': 0.0011095700416088765, 'mean_word_length': 2.8810548977395047, 'pattern_counts': {'":': 0, '<': 9, '<?xml version=': 0, '>': 9, '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': '6924989', 'n_tokens_mistral': 2952, 'n_tokens_neox': 2554, 'n_words': 711}