mirror of
https://github.com/gcc-mirror/gcc.git
synced 2024-11-21 13:40:47 +00:00
e866d08d8b
Hello all, this patch checks in mdcompact, the tool written in elisp that I used to mass convert all the multi choice pattern in the aarch64 back-end to the new compact syntax. I tested it on Emacs 29 (might run on older versions as well not sure), also I verified it runs cleanly on a few other back-ends (arm, loongarch). The tool can be used to convert a single pattern, an open buffer or all md files in a directory. The tool might need further adjustment to run on some specific back-end, in case very happy to help. This patch was pre-approved here [1]. Best Regards Andrea Corallo [1] <https://gcc.gnu.org/pipermail/gcc-patches/2023-October/631830.html> contrib/ChangeLog * mdcompact/mdcompact-testsuite.el: New file. * mdcompact/mdcompact.el: Likewise. * mdcompact/tests/1.md: Likewise. * mdcompact/tests/1.md.out: Likewise. * mdcompact/tests/2.md: Likewise. * mdcompact/tests/2.md.out: Likewise. * mdcompact/tests/3.md: Likewise. * mdcompact/tests/3.md.out: Likewise. * mdcompact/tests/4.md: Likewise. * mdcompact/tests/4.md.out: Likewise. * mdcompact/tests/5.md: Likewise. * mdcompact/tests/5.md.out: Likewise. * mdcompact/tests/6.md: Likewise. * mdcompact/tests/6.md.out: Likewise. * mdcompact/tests/7.md: Likewise. * mdcompact/tests/7.md.out: Likewise.
297 lines
8.8 KiB
EmacsLisp
297 lines
8.8 KiB
EmacsLisp
;;; -*- lexical-binding: t; -*-
|
|
|
|
;; Author: Andrea Corallo <andrea.corallo@arm.com>
|
|
;; Package: mdcompact
|
|
;; Keywords: languages, extensions
|
|
;; Package-Requires: ((emacs "29"))
|
|
|
|
;; This file is part of GCC.
|
|
|
|
;; GCC is free software: you can redistribute it and/or modify it
|
|
;; under the terms of the GNU General Public License as published by
|
|
;; the Free Software Foundation, either version 3 of the License, or
|
|
;; (at your option) any later version.
|
|
|
|
;; GCC is distributed in the hope that it will be useful, but WITHOUT
|
|
;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
|
;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public
|
|
;; License for more details.
|
|
|
|
;; You should have received a copy of the GNU General Public License
|
|
;; along with GCC. If not, see <https://www.gnu.org/licenses/>.
|
|
|
|
;;; Commentary:
|
|
|
|
;; Convert multi choice GCC machine description patterns to compact
|
|
;; syntax.
|
|
|
|
;;; Usage:
|
|
|
|
;; With the point on a pattern run 'M-x mdcomp-run-at-point' to
|
|
;; convert that pattern.
|
|
|
|
;; Run 'M-x mdcomp-run-buffer' to convert all convertible patterns in
|
|
;; the current buffer.
|
|
|
|
;; Run 'M-x mdcomp-run-directory' to convert all convertible patterns
|
|
;; in a directory.
|
|
|
|
;; One can invoke the tool from shell as well, ex for running it on
|
|
;; the arm backend from the GCC checkout directory:
|
|
;; emacs -batch -l ./contrib/mdcompact/mdcompact.el -f mdcomp-run-directory ./gcc/config/arm/
|
|
|
|
;;; Code:
|
|
|
|
(require 'cl-lib)
|
|
(require 'rx)
|
|
|
|
(defconst
|
|
mdcomp-constr-rx
|
|
(rx "(match_operand" (? ":" (1+ (or punct alnum)))
|
|
(1+ space) (group-n 1 num) (1+ space) "\""
|
|
(1+ (or alnum "_" "<" ">")) "\""
|
|
(group-n 2 (1+ space) "\"" (group-n 3 (0+ (not "\""))) "\"")
|
|
")"))
|
|
|
|
(cl-defstruct mdcomp-operand
|
|
num
|
|
cstr)
|
|
|
|
(cl-defstruct mdcomp-attr
|
|
name
|
|
vals)
|
|
|
|
;; A reasonable name
|
|
(rx-define mdcomp-name (1+ (or alnum "_")))
|
|
|
|
(defconst mdcomp-attr-rx
|
|
(rx "(set_attr" (1+ space) "\""
|
|
(group-n 1 mdcomp-name)
|
|
"\"" (1+ space) "\""
|
|
(group-n 2 (1+ (not ")")))
|
|
"\"" (0+ space) ")"))
|
|
|
|
(defun mdcomp-parse-delete-attr ()
|
|
(save-match-data
|
|
(when (re-search-forward mdcomp-attr-rx nil t)
|
|
(let ((res (save-match-data
|
|
(make-mdcomp-attr
|
|
:name (match-string-no-properties 1)
|
|
:vals (cl-delete-if #'string-empty-p
|
|
(split-string
|
|
(replace-regexp-in-string
|
|
(rx "\\") ""
|
|
(match-string-no-properties 2))
|
|
(rx (1+ (or space ",")))))))))
|
|
(if (length= (mdcomp-attr-vals res) 1)
|
|
'short
|
|
(delete-region (match-beginning 0) (match-end 0))
|
|
res)))))
|
|
|
|
(defun mdcomp-parse-attrs ()
|
|
(save-excursion
|
|
(let* ((res (cl-loop for x = (mdcomp-parse-delete-attr)
|
|
while x
|
|
collect x))
|
|
(beg (re-search-backward (rx bol (1+ space) "["))))
|
|
(unless (memq 'short res)
|
|
(when res
|
|
(delete-region beg (re-search-forward (rx "]")))))
|
|
(cl-delete 'short res))))
|
|
|
|
(defun mdcomp-remove-quoting (beg)
|
|
(save-excursion
|
|
(save-match-data
|
|
(replace-regexp-in-region (regexp-quote "\\\\") "\\\\" beg (point-max))
|
|
(replace-regexp-in-region (regexp-quote "\\\"") "\"" beg (point-max)))))
|
|
|
|
(defun mdcomp-remove-escaped-newlines (beg)
|
|
(save-excursion
|
|
(save-match-data
|
|
(replace-regexp-in-region (rx "\\" eol (0+ space)) " " beg (point-max)))))
|
|
|
|
(defun mdcomp-parse-delete-cstr ()
|
|
(cl-loop while (re-search-forward mdcomp-constr-rx nil t)
|
|
unless (string= "" (match-string-no-properties 3))
|
|
collect (save-match-data
|
|
(make-mdcomp-operand
|
|
:num (string-to-number (match-string-no-properties 1))
|
|
:cstr (cl-delete-if #'string-empty-p
|
|
(split-string
|
|
(replace-regexp-in-string " " ""
|
|
(match-string-no-properties 3))
|
|
(rx (1+ ","))))))
|
|
do (delete-region (match-beginning 2) (match-end 2))))
|
|
|
|
(defun mdcomp-run* ()
|
|
(let* ((ops (mdcomp-parse-delete-cstr))
|
|
(attrs (mdcomp-parse-attrs))
|
|
(beg (re-search-forward "\"@")))
|
|
(cl-sort ops (lambda (x y)
|
|
(< (mdcomp-operand-num x) (mdcomp-operand-num y))))
|
|
(mdcomp-remove-escaped-newlines beg)
|
|
(save-match-data
|
|
(save-excursion
|
|
(left-char 2)
|
|
(forward-sexp)
|
|
(left-char 1)
|
|
(delete-char 1)
|
|
(insert "\n }")))
|
|
(mdcomp-remove-quoting beg)
|
|
(replace-match "{@")
|
|
(re-search-forward (rx (or "\"" ")")))
|
|
(re-search-backward "@")
|
|
(right-char 1)
|
|
(insert "[ cons: ")
|
|
(cl-loop
|
|
for op in ops
|
|
when (string-match "=" (cl-first (mdcomp-operand-cstr op)))
|
|
do (insert "=")
|
|
do (insert (number-to-string (mdcomp-operand-num op)) ", ")
|
|
finally
|
|
(progn
|
|
;; In case add attributes names
|
|
(when attrs
|
|
(delete-char -2)
|
|
(insert "; attrs: ")
|
|
(cl-loop for attr in attrs
|
|
do (insert (mdcomp-attr-name attr) ", ")))
|
|
(delete-char -2)
|
|
(insert "]")))
|
|
(cl-loop
|
|
while (re-search-forward (rx bol (0+ space) (or (group-n 1 "* return")
|
|
(group-n 2 "}")
|
|
"#" alpha "<"))
|
|
nil t)
|
|
for i from 0
|
|
when (match-string 2)
|
|
do (cl-return)
|
|
when (match-string 1)
|
|
do (progn
|
|
(delete-region (match-beginning 1) (+ (match-beginning 1) (length "* return")))
|
|
(insert "<<")
|
|
(left-char 1))
|
|
do
|
|
(progn
|
|
(left-char 1)
|
|
(cl-loop
|
|
initially (insert " [ ")
|
|
for op in ops
|
|
for c = (nth i (mdcomp-operand-cstr op))
|
|
unless c
|
|
do (cl-return)
|
|
do (insert (if (string-match "=" c)
|
|
(substring c 1 nil)
|
|
c)
|
|
", ")
|
|
finally (progn
|
|
(when attrs
|
|
(delete-char -2)
|
|
(insert "; ")
|
|
(cl-loop for attr in attrs
|
|
for str = (nth i (mdcomp-attr-vals attr))
|
|
when str
|
|
do (insert str)
|
|
do (insert ", ")))
|
|
(delete-char -2)
|
|
(insert " ] ")
|
|
(move-end-of-line 1)))))
|
|
;; remove everything after ] align what needs to be aligned
|
|
;; and re-add the asm template
|
|
(re-search-backward (regexp-quote "@[ cons:"))
|
|
(let* ((n (length (mdcomp-operand-cstr (car ops))))
|
|
(asms (cl-loop
|
|
initially (re-search-forward "]")
|
|
repeat n
|
|
collect (let* ((beg (re-search-forward "]"))
|
|
(end (re-search-forward (rx eol)))
|
|
(str (buffer-substring-no-properties beg end)))
|
|
(delete-region beg end)
|
|
str)))
|
|
(beg (re-search-backward (regexp-quote "@[ cons:")))
|
|
(indent-tabs-mode nil))
|
|
(re-search-forward "}")
|
|
(align-regexp beg (point) (rx (group-n 1 "") "["))
|
|
(align-regexp beg (point) (rx (group-n 1 "") (or "," ";")) nil nil t)
|
|
(align-regexp beg (point) (rx (group-n 1 "") "]"))
|
|
(goto-char beg)
|
|
(cl-loop
|
|
initially (re-search-forward "]")
|
|
for i below n
|
|
do (progn
|
|
(re-search-forward "]")
|
|
(insert (nth i asms))))
|
|
(when (re-search-forward (rx (1+ (or space eol)) ")") nil t)
|
|
(replace-match "\n)" nil t)))))
|
|
|
|
(defun mdcomp-narrow-to-md-pattern ()
|
|
(condition-case nil
|
|
(let ((beg (re-search-forward "\n("))
|
|
(end (re-search-forward (rx bol (1+ ")")))))
|
|
(narrow-to-region beg end))
|
|
(error
|
|
(narrow-to-defun))))
|
|
|
|
(defun mdcomp-run-at-point ()
|
|
"Convert the multi choice top-level form around point to compact syntax."
|
|
(interactive)
|
|
(save-restriction
|
|
(save-mark-and-excursion
|
|
(mdcomp-narrow-to-md-pattern)
|
|
(goto-char (point-min))
|
|
(let ((pattern-name (save-excursion
|
|
(re-search-forward (rx "\"" (group-n 1 (1+ (not "\""))) "\""))
|
|
(match-string-no-properties 1)))
|
|
(orig-text (buffer-substring-no-properties (point-min) (point-max))))
|
|
(condition-case nil
|
|
(progn
|
|
(mdcomp-run*)
|
|
(message "Converted: %s" pattern-name))
|
|
(error
|
|
(message "Skipping convertion for: %s" pattern-name)
|
|
(delete-region (point-min) (point-max))
|
|
(insert orig-text)
|
|
'fail))))))
|
|
|
|
(defun mdcomp-run-buffer ()
|
|
"Convert the multi choice top-level forms in the buffer to compact syntax."
|
|
(interactive)
|
|
(save-excursion
|
|
(message "Conversion for buffer %s started" (buffer-file-name))
|
|
(goto-char (point-min))
|
|
(while (re-search-forward
|
|
(rx "match_operand" (1+ any) letter (0+ space) "," (0+ space) letter) nil t)
|
|
(when (eq (mdcomp-run-at-point) 'fail)
|
|
(condition-case nil
|
|
(forward-sexp)
|
|
(error
|
|
;; If forward-sexp fails falls back.
|
|
(re-search-forward (rx ")" eol eol))))))
|
|
(message "Conversion done")))
|
|
|
|
(defconst mdcomp-file-rx (rx bol alpha (0+ not-newline) ".md" eol))
|
|
|
|
(defun mdcomp-run-directory (folder &optional recursive)
|
|
"Run el mdcompact on a FOLDER possibly in a RECURSIVE fashion."
|
|
(interactive "D")
|
|
(let ((before-save-hook nil)
|
|
(init-time (current-time)))
|
|
(mapc (lambda (f)
|
|
(with-temp-file f
|
|
(message "Working on %s" f)
|
|
(insert-file-contents f)
|
|
(mdcomp-run-buffer)
|
|
(message "Done with %s" f)))
|
|
(if recursive
|
|
(directory-files-recursively folder mdcomp-file-rx)
|
|
(directory-files folder t mdcomp-file-rx)))
|
|
(message "Converted in %f sec" (float-time (time-since init-time)))))
|
|
|
|
(defun mdcomp-batch-run-directory ()
|
|
"Same as `mdcomp-run-directory' but use cmd line args."
|
|
(mdcomp-run-directory (nth 0 argv) (nth 1 argv)))
|
|
|
|
(provide 'mdcompact)
|
|
|
|
;;; mdcompact.el ends here
|