From a67d16bbc21a1f9b33ffd71841f0dbbf753a71eb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= Date: Mon, 14 Sep 2020 16:50:15 +0200 Subject: [PATCH] utils: add the utility to help parsing/generating symbols_list.h --- src/util/gen-symbol-table.lisp | 153 +++++++++++++++++++++++++++++++++ 1 file changed, 153 insertions(+) create mode 100644 src/util/gen-symbol-table.lisp diff --git a/src/util/gen-symbol-table.lisp b/src/util/gen-symbol-table.lisp new file mode 100644 index 00000000..449db50b --- /dev/null +++ b/src/util/gen-symbol-table.lisp @@ -0,0 +1,153 @@ +;;; This file is used to generate symbols_list.h. Go to the last page to see +;;; an ad-hoc parser for the old symbols_list.h from which the current +;;; definitions were created. Keep in mind that it is only a helper to +;;; generate the cl_symbols table in a desired format, some manual curation is +;;; also needed (i.e modification of the structure etc). + + +;;; Utilities + +(defvar *pkg+kind-mapping* + `(("CL_ORDINARY" :cl :ordinary) + ("CL_SPECIAL" :cl :special) + ("CL_CONSTANT" :cl :constant) + ("CL_FORM" :cl :form) + ("SI_ORDINARY" :si :ordinary) + ("SI_SPECIAL" :si :special) + ("SI_CONSTANT" :si :constant) + ("EXT_ORDINARY" :ext :ordinary) + ("EXT_SPECIAL" :ext :special) + ("EXT_CONSTANT" :ext :constant) + ("EXT_FORM" :ext :form) + ("MP_ORDINARY" :mp :ordinary) + ("MP_SPECIAL" :mp :special) + ("MP_CONSTANT" :mp :constant) + ("CLOS_ORDINARY" :clos :ordinary) + ("CLOS_SPECIAL" :clos :special) + ("CLOS_ORDINARY | PRIVATE" :clos :private) + ("KEYWORD" :keyword :constant) + ("GRAY_ORDINARY" :gray :ordinary) + ("FFI_ORDINARY" :ffi :ordinary) + ("FFI_CONSTANT" :ffi :constant))) + +(defun pkg+kind->type (pkg kind) + (car (find (list pkg kind) *pkg+kind-mapping* :key #'cdr :test #'equal))) + +(defun type->pkg+kind (type) + (cdr (find type *pkg+kind-mapping* :key #'car :test #'equal))) + +(defun split-sequence (char string &aux acc) + (do ((line string (subseq line (1+ (position char line))))) + ((null (position char line)) + (push line acc) + (nreverse (mapcar (lambda (str) + (string-trim '(#\space) str)) + acc))) + (push (subseq line 0 (position char line)) acc))) + + +;;; Parser returns a list of "lines" in a preprocessed form: +;;; +;;; (line-type ,@arguments) ; or +;;; (pack name kind value cfun narg) +;;; +;;; LINE-TYPE is either :macro, :comment, :newline, :end-tag or :entry. PACK +;;; is one of core packages (i.e :ffi), NAME is the symbol name etc. CFUN is +;;; the name of the corresponding C function. +;;; +;;; Entry parsers have versions so it is possible to parse and generate older +;;; versions of the table. +;;; +;;; Example usage: +;;; +#+(or) +(let ((symbols-list (parse-symbols-list "path/to/symbols_list.h" #'v1-parse-entry))) + (generate-symbols-list symbols_list #'v1-generate-entry)) + +(defun parse-symbols-list (path parser) + (with-open-file (s path) + (do ((line (read-line s nil :eof) + (read-line s nil :eof)) + results) + ((eq line :eof) (nreverse results)) + (push + (cond ((zerop (length line)) + `(:newline)) + ((search "}};" line) + `(:end-tag ,(funcall parser line))) + ((case (char line 0) + (#\{ `(:entry ,(funcall parser line))) + (#\# `(:macro ,line)) + (otherwise (if (zerop (length line)) + `(:newline) + `(:comment ,line)))))) + results)))) + +(defun generate-symbols-list (results generator) + (loop for line in results + do (case (first line) + (:macro (format t "~a~%" (second line))) + (:comment (format t "~a~%" (second line))) + (:newline (terpri)) + (:end-tag (format t "~a};~%" (apply generator (second line)))) + (:entry (format t "~a,~%" (apply generator (second line))))))) + +(defun v1-parse-entry (line) + (destructuring-bind (name package+kind cfun narg value) + (split-sequence #\, (subseq line + (1+ (position #\{ line)) + (position #\} line))) + (let* ((pkg-kind (type->pkg+kind package+kind)) + (pack (first pkg-kind)) + (kind (second pkg-kind)) + (narg (parse-integer narg))) + (list pack name kind value cfun narg)))) + +(defun v1-generate-entry (package name kind value cfun narg) + (let ((type (pkg+kind->type package kind)) + (narg (or narg -1))) + (format nil "{~a, ~a, ~a, ~d, ~a}" + name type cfun narg value))) + +;;; V2 is defined to unify symbols_list.h files between ECL core and DPP. Also +;;; it gives the all_symbols.d module an insight for the predefined symbol +;;; name mappings (see #534). +(defun v2-parse-entry (line) + (let* ((fun-pos (search "ECL_FUN" line)) + (var-pos (search "ECL_VAR" line)) + (end-pos (position #\) line :from-end t)) + (name (subseq line 1 (1- fun-pos))) + (fun-arg (split-sequence #\, (subseq line + (+ fun-pos 8) + (- var-pos 2)))) + (var-arg (split-sequence #\, (subseq line + (+ var-pos 8) + end-pos)))) + (destructuring-bind (fun-name cfun narg) fun-arg + (declare (ignore fun-name)) + (destructuring-bind (type value) var-arg + (let* ((pkg-kind (type->pkg+kind type)) + (pack (first pkg-kind)) + (kind (second pkg-kind)) + (narg (parse-integer narg))) + (list pack name kind value cfun narg)))))) + +(defun v2-generate-entry (package name kind value cfun narg) + (let ((type (pkg+kind->type package kind)) + (narg (or narg -1)) + (fun-name (let* ((start (position #\( cfun :from-end t)) + (end (position #\) cfun)) + ;; Find the "innermost" symbol, i.e for + ;; IF_DFFI(ECL_NAME(foobar)) it is foobar + (fname (if start + (subseq cfun + (1+ start) + end) + cfun))) + ;; If it is NULL, we want to specify NULL, otherwise we + ;; wrap the symbol in quotes to have a string. + (if (string= fname "NULL") + "NULL" + (format nil "~s" fname))))) + (format nil "{~a ECL_FUN(~a, ~a, ~a) ECL_VAR(~a, ~a)}" + name fun-name cfun narg type value)))