<commit_before>;(in-package #:cl-react)
 
(defvar *test*
  '(:a 
    :href "#"
    :disabled t
    (:span :class "text-primary" "Some text")
    (:span :class "text-muted" (:i :class "pencil-icon"))))


(defparameter *binary-attrs*
  '(:read-only
    :disabled
    :hidden)
  "True/false attributes. When set to NIL, they are simply ignored.")


(defconstant +dom-types+
  '(:MATH :SVG :A :ABBR :ADDRESS :AREA :ARTICLE :ASIDE :AUDIO :B :BASE :BDI :BDO
 :BLOCKQUOTE :BODY :BR :BUTTON :BUTTON :BUTTON :BUTTON :CANVAS :CAPTION :CITE
 :CODE :COL :COLGROUP :COMMAND :COMMAND :COMMAND :COMMAND :DATALIST :DD :DEL
 :DETAILS :DFN :DIV :DL :DT :EM :EMBED :FIELDSET :FIGCAPTION :FIGURE :FOOTER
 :FORM :H1 :H2 :H3 :H4 :H5 :H6 :HEAD :HEADER :HGROUP :HR :HTML :I :IFRAME :IMG
 :INPUT :INS :KBD :KEYGEN :LABEL :LEGEND :LI :LINK :MAP :MARK :MENU
 :META :META :META :META :META :META :METER :NAV :NOSCRIPT :OBJECT :OL
 :OPTGROUP :OPTION :OUTPUT :P :PARAM :PRE :PROGRESS :Q :RP :RT :RUBY :S :SAMP
 :SCRIPT :SECTION :SELECT :SMALL :SOURCE :SPAN :STRONG :STYLE :SUB :SUMMARY
 :SUP :TABLE :TBODY :TD :TEXTAREA :TFOOT :TH :THEAD :TIME :TITLE :TR :TRACK :U
    :UL :VAR :VIDEO :WBR))
	    
(defparameter *attr-synonyms*
  '(:readonly :read-only
    :class :class-name)
  "HTML attributes that differ from JSX or that need some doctoring to work with Parenscript")

(defun parse-attr (attr value)
  (let ((jsx-attr (or (getf *attr-synonyms* attr) attr)))
    (when (or (not (find jsx-attr *binary-attrs*)) value)
	(list (make-symbol (string jsx-attr)) value))))
	

(defun parse-node (node)
  (let (done attr props)
    (if (atom node)
	node
	(do* ((tokens (rest node) (funcall (if done #'identity #'rest) tokens))
	      (token (first tokens) (first tokens)))
	     ((or done (null tokens))
	      (list :type (first node) :props props :children tokens))
	  (cond (attr (setf props (list* attr token props)
			    attr nil))
		((keywordp token) (setf attr token))
		(t (setf done t)))))))

(defun traverse-tree (function tree)
  (let ((stack (list (list :parent nil :child tree))))
    (do ((top (pop stack) (pop stack)))
	((null top))
      (multiple-value-bind (node children) (apply function top)
	(dolist (child children)
	  (push (list :parent node :child child) stack))))))
	  
	    	      
(defun parse-tree (tree)
  (let (root parsed-node children)
      (traverse-tree
       (lambda (&key child parent)
	 (setf parsed-node (parse-node child)
	       children (and (listp parsed-node) (getf parsed-node :children)))
	 (when (null root)
	   (setf root parsed-node))
	 (when children
	   (setf (getf parsed-node :children) nil))
	 (when parent
	   (push parsed-node (getf parent :children)))
	 (values parsed-node children))
       tree)
      root))
		     
  
(defun dom-type-p (type)
  (find type +dom-types+))

(defun compile-node (parsed-node)
  (if (atom parsed-node)
      parsed-node
      (destructuring-bind (&key type props children) parsed-node
	(let* ((type-sym
		(make-symbol (string type)))
	       (props-obj
		(cond
		  (props `((ps:create ,@props)))
		  (children (list nil))))
	       (is-dom-type (dom-type-p type))
	       (inner-form
		(if is-dom-type
		    `(,type-sym ,@props-obj)
		    `(create-element ,type-sym ,@props-obj))))
	  (values
	   (if is-dom-type
	       `(ps:chain React DOM ,inner-form)
	       `(ps:chain React ,inner-form))
	   (cdr inner-form)
	   children)))))

(defun compile-tree (parsed-tree)
  (let (root)
    (traverse-tree
     (lambda (&key parent child)
       (multiple-value-bind (outer-form inner-form children) (compile-node child)
	 (when (null root)
	   (setf root outer-form))
	 (when parent
	   (cond
	     ((null (cdr parent))
	      (push outer-form (cdr parent)))
	     ((and (listp (cadr parent))
		   (eql (caadr parent) 'list))
	      (push outer-form (cdadr parent)))
	     (t
	      (setf (cadr parent)
		    (list 'list outer-form (cadr parent))))))
	 (values inner-form children)))
     parsed-tree)
    root))
	 
(ps:defpsmacro psx (form)<commit_msg>Simplify implementaiton of COMPILE-TREE<commit_after>;(in-package #:cl-react)
 
(defvar *test*
  '(:a 
    :href "#"
    :disabled t
    (:span :class "text-primary" "Some text")
    (:span :class "text-muted" (:i :class "pencil-icon"))))


(defparameter *binary-attrs*
  '(:read-only
    :disabled
    :hidden)
  "True/false attributes. When set to NIL, they are simply ignored.")


(defconstant +dom-types+
  '(:math :svg :a :abbr :address :area :article :aside :audio :b :base :bdi :bdo
 :blockquote :body :br :button :button :button :button :canvas :caption :cite
 :code :col :colgroup :command :command :command :command :datalist :dd :del
 :details :dfn :div :dl :dt :em :embed :fieldset :figcaption :figure :footer
 :form :h1 :h2 :h3 :h4 :h5 :h6 :head :header :hgroup :hr :html :i :iframe :img
 :input :ins :kbd :keygen :label :legend :li :link :map :mark :menu
 :meta :meta :meta :meta :meta :meta :meter :nav :noscript :object :ol
 :optgroup :option :output :p :param :pre :progress :q :rp :rt :ruby :s :samp
 :script :section :select :small :source :span :strong :style :sub :summary
 :sup :table :tbody :td :textarea :tfoot :th :thead :time :title :tr :track :u
    :ul :var :video :wbr))
	    
(defparameter *attr-synonyms*
  '(:readonly :read-only
    :class :class-name)
  "HTML attributes that differ from JSX or that need some doctoring to work with Parenscript")

(defun parse-attr (attr value)
  (let ((jsx-attr (or (getf *attr-synonyms* attr) attr)))
    (when (or (not (find jsx-attr *binary-attrs*)) value)
	(list (make-symbol (string jsx-attr)) value))))
	

(defun parse-node (node)
  (let (done attr props)
    (if (atom node)
	node
	(do* ((tokens (rest node) (funcall (if done #'identity #'rest) tokens))
	      (token (first tokens) (first tokens)))
	     ((or done (null tokens))
	      (list :type (first node) :props props :children tokens))
	  (cond (attr (setf props (list* attr token props)
			    attr nil))
		((keywordp token) (setf attr token))
		(t (setf done t)))))))

(defun traverse-tree (function tree)
  (let ((stack (list (list :parent nil :child tree))))
    (do ((top (pop stack) (pop stack)))
	((null top))
      (multiple-value-bind (node children) (apply function top)
	(dolist (child children)
	  (push (list :parent node :child child) stack))))))
	  
	    	      
(defun parse-tree (tree)
  (let (root parsed-node children)
      (traverse-tree
       (lambda (&key child parent)
	 (setf parsed-node (parse-node child)
	       children (and (listp parsed-node) (getf parsed-node :children)))
	 (when (null root)
	   (setf root parsed-node))
	 (when children
	   (setf (getf parsed-node :children) nil))
	 (when parent
	   (push parsed-node (getf parent :children)))
	 (values parsed-node children))
       tree)
      root))
		     
  
(defun dom-type-p (type)
  (find type +dom-types+))

(defun compile-node (parsed-node)
  (if (atom parsed-node)
      parsed-node
      (destructuring-bind (&key type props children) parsed-node
	(let ((type-sym
		(make-symbol (string type)))
	       (props-obj
		(cond
		  (props `((ps:create ,@props)))
		  (children (list nil)))))
	  (values
	   (if (dom-type-p type)
	       `(ps:chain React DOM (,type-sym ,@props-obj))
	       `(ps:chain React (create-element ,type-sym ,@props-obj)))
	   children)))))

(defun compile-tree (parsed-tree)
  (let ((adjacency-table (make-hash-table))
	(root nil))
    (traverse-tree
     (lambda (&key parent child)
       (multiple-value-bind (compiled-node children) (compile-node child)
	 (push compiled-node (gethash parent adjacency-table))
	 (values compiled-node children)))
     parsed-tree)
    (maphash
     (lambda (parent children)
       (if (null parent)
	   (setf root (first children))
	   (setf (cdr (last (car (last parent))))
		 (if (rest children)
		     `((list ,@children))
		     `(,(first children))))))
       adjacency-table)
     root))
	     	 
(ps:defpsmacro psx (form)
{'fraction_non_alphanumeric': 0.15623422513881877, 'fraction_numerical': 0.001514386673397274, 'mean_word_length': 3.2745415318230853, 'pattern_counts': {'":': 0, '<': 3, '<?xml version=': 0, '>': 3, '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': '28750', 'n_tokens_mistral': 2899, 'n_tokens_neox': 2761, 'n_words': 906}