From 36082a2fe36ecd800d784ae44c14f1f18c66a7e9 Mon Sep 17 00:00:00 2001 From: Daniel Baumann Date: Sun, 28 Apr 2024 09:33:12 +0200 Subject: Adding upstream version 3.7.9. Signed-off-by: Daniel Baumann --- guile/modules/system/documentation/README | 15 ++ guile/modules/system/documentation/c-snarf.scm | 210 +++++++++++++++++++++++++ guile/modules/system/documentation/output.scm | 176 +++++++++++++++++++++ 3 files changed, 401 insertions(+) create mode 100644 guile/modules/system/documentation/README create mode 100644 guile/modules/system/documentation/c-snarf.scm create mode 100644 guile/modules/system/documentation/output.scm (limited to 'guile/modules/system/documentation') diff --git a/guile/modules/system/documentation/README b/guile/modules/system/documentation/README new file mode 100644 index 0000000..d8dba12 --- /dev/null +++ b/guile/modules/system/documentation/README @@ -0,0 +1,15 @@ +C Documentation Snarfing Modules +-------------------------------- + +This modules provide allow the extraction of Texinfo documentation +strings from C files---this is usually referred to as ``doc snarfing'' +in Guile terms. + +They were stolen from Guile-Reader 0.3: + + https://www.nongnu.org/guile-reader/ + +It was only slightly modified. + + +Ludovic Courtès . diff --git a/guile/modules/system/documentation/c-snarf.scm b/guile/modules/system/documentation/c-snarf.scm new file mode 100644 index 0000000..5e54da3 --- /dev/null +++ b/guile/modules/system/documentation/c-snarf.scm @@ -0,0 +1,210 @@ +;;; c-snarf.scm -- Parsing documentation "snarffed" from C files. +;;; +;;; Copyright 2006-2012 Free Software Foundation, Inc. +;;; +;;; +;;; This program 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. +;;; +;;; This program 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 this program; if not, write to the Free Software +;;; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA + +(define-module (system documentation c-snarf) + :use-module (ice-9 popen) + :use-module (ice-9 rdelim) + + :use-module (srfi srfi-13) + :use-module (srfi srfi-14) + :use-module (srfi srfi-39) + + :export (run-cpp-and-extract-snarfing + parse-snarfing + parse-snarfed-line)) + +;;; Author: Ludovic Courtès +;;; +;;; Commentary: +;;; +;;; This module provides tools to parse and otherwise manipulate +;;; documentation "snarffed" from C files, i.e., information obtained by +;;; running the C preprocessor with the @code{-DSCM_MAGIC_SNARF_DOCS} flag. +;;; +;;; Code: + + + +;;; +;;; High-level API. +;;; + +(define (run-cpp-and-extract-snarfing file cpp cpp-flags) + (let ((pipe (apply open-pipe* OPEN_READ + (cons cpp (append cpp-flags (list file)))))) + (parse-snarfing pipe))) + + +;;; +;;; Parsing magic-snarffed CPP output. +;;; + +(define (parse-c-argument-list arg-string) + "Parse @var{arg-string} (a string representing a ANSI C argument list, +e.g., @var{(const SCM first, SCM second_arg)}) and return a list of strings +denoting the argument names." + (define %c-symbol-char-set + (char-set-adjoin char-set:letter+digit #\_)) + + (let loop ((args (string-tokenize (string-trim-both arg-string #\space) + %c-symbol-char-set)) + (type? #t) + (result '())) + (if (null? args) + (reverse! result) + (let ((the-arg (car args))) + (cond ((and type? (string=? the-arg "const")) + (loop (cdr args) type? result)) + ((and type? (string=? the-arg "SCM")) + (loop (cdr args) (not type?) result)) + (type? ;; any other type, e.g., `void' + (loop (cdr args) (not type?) result)) + (else + (loop (cdr args) (not type?) (cons the-arg result)))))))) + +(define (parse-documentation-item item) + "Parse @var{item} (a string), a single function string produced by the C +preprocessor. The result is an alist whose keys represent specific aspects +of a procedure's documentation: @code{c-name}, @code{scheme-name}, + @code{documentation} (a Texinfo documentation string), etc." + + (define (read-strings) + ;; Read several subsequent strings and return their concatenation. + (let loop ((str (read)) + (result '())) + (if (or (eof-object? str) + (not (string? str))) + (string-concatenate (reverse! result)) + (loop (read) (cons str result))))) + + (let* ((item (string-trim-both item #\space)) + (space (string-index item #\space))) + (if (not space) + (error "invalid documentation item" item) + (let ((kind (substring item 0 space)) + (rest (substring item space (string-length item)))) + (cond ((string=? kind "cname") + (cons 'c-name (string-trim-both rest #\space))) + ((string=? kind "fname") + (cons 'scheme-name + (with-input-from-string rest read-strings))) + ((string=? kind "type") + (cons 'type (with-input-from-string rest read))) + ((string=? kind "location") + (cons 'location + (with-input-from-string rest + (lambda () + (let loop ((str (read)) + (result '())) + (if (eof-object? str) + (reverse! result) + (loop (read) (cons str result)))))))) + ((string=? kind "arglist") + (cons 'arguments + (parse-c-argument-list rest))) + ((string=? kind "argsig") + (cons 'signature + (with-input-from-string rest + (lambda () + (let ((req (read)) (opt (read)) (rst? (read))) + (list (cons 'required req) + (cons 'optional opt) + (cons 'rest? (= 1 rst?)))))))) + (else + ;; docstring (may consist of several C strings which we + ;; assume to be equivalent to Scheme strings) + (cons 'documentation + (with-input-from-string item read-strings)))))))) + +(define (parse-snarfed-line line) + "Parse @var{line}, a string that contains documentation returned for a +single function by the C preprocessor with the @code{-DSCM_MAGIC_SNARF_DOCS} +option. @var{line} is assumed to be a complete \"^^ { ... ^^ }\" sequence." + (define (caret-split str) + (let loop ((str str) + (result '())) + (if (string=? str "") + (reverse! result) + (let ((caret (string-index str #\^)) + (len (string-length str))) + (if caret + (if (and (> (- len caret) 0) + (eq? (string-ref str (+ caret 1)) #\^)) + (loop (substring str (+ 2 caret) len) + (cons (string-take str (- caret 1)) result)) + (error "single caret not allowed" str)) + (loop "" (cons str result))))))) + + (let ((items (caret-split (substring line 4 + (- (string-length line) 4))))) + (map parse-documentation-item items))) + + +(define (parse-snarfing port) + "Read C preprocessor (where the @code{SCM_MAGIC_SNARF_DOCS} macro is +defined) output from @var{port} a return a list of alist, each of which +contains information about a specific function described in the C +preprocessor output." + (define start-marker "^^ {") + (define end-marker "^^ }") + + (define (read-snarf-lines start) + ;; Read the snarf lines that follow START until and end marker is found. + (let loop ((line start) + (result '())) + (cond ((eof-object? line) + ;; EOF in the middle of a "^^ { ... ^^ }" sequence; shouldn't + ;; happen. + line) + ((string-contains line end-marker) + => + (lambda (end) + (let ((result (cons (string-take line (+ 3 end)) + result))) + (string-concatenate-reverse result)))) + ((string-prefix? "#" line) + ;; Presumably a "# LINENUM" directive; skip it. + (loop (read-line port) result)) + (else + (loop (read-line port) + (cons line result)))))) + + (let loop ((line (read-line port)) + (result '())) + (cond ((eof-object? line) + result) + ((string-contains line start-marker) + => + (lambda (start) + (let ((line + (read-snarf-lines (string-drop line start)))) + (loop (read-line port) + (cons (parse-snarfed-line line) result))))) + (else + (loop (read-line port) result))))) + + +;;; c-snarf.scm ends here + +;;; Local Variables: +;;; mode: scheme +;;; coding: latin-1 +;;; End: + +;;; arch-tag: dcba2446-ee43-46d8-a47e-e6e12f121988 diff --git a/guile/modules/system/documentation/output.scm b/guile/modules/system/documentation/output.scm new file mode 100644 index 0000000..d60fe44 --- /dev/null +++ b/guile/modules/system/documentation/output.scm @@ -0,0 +1,176 @@ +;;; output.scm -- Output documentation "snarffed" from C files in Texi/GDF. +;;; +;;; Copyright 2006-2012 Free Software Foundation, Inc. +;;; +;;; +;;; This program 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. +;;; +;;; This program 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 this program; if not, write to the Free Software +;;; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA + +(define-module (system documentation output) + :use-module (srfi srfi-1) + :use-module (srfi srfi-13) + :use-module (srfi srfi-39) + :autoload (system documentation c-snarf) (run-cpp-and-extract-snarfing) + + :export (schemify-name scheme-procedure-texi-line + procedure-gdf-string procedure-texi-documentation + output-procedure-texi-documentation-from-c-file + *document-c-functions?*)) + +;;; Author: Ludovic Courtès +;;; +;;; Commentary: +;;; +;;; This module provides support function to issue Texinfo or GDF (Guile +;;; Documentation Format) documentation from "snarffed" C files. +;;; +;;; Code: + + +;;; +;;; Utility. +;;; + +(define (schemify-name str) + "Turn @var{str}, a C variable or function name, into a more ``Schemey'' +form, e.g., one with dashed instead of underscores, etc." + (string-map (lambda (chr) + (if (eq? chr #\_) + #\- + chr)) + (if (string-suffix? "_p" str) + (string-append (substring str 0 + (- (string-length str) 2)) + "?") + str))) + + +;;; +;;; Issuing Texinfo and GDF-formatted doc (i.e., `guile-procedures.texi'). +;;; GDF = Guile Documentation Format +;;; + +(define *document-c-functions?* + ;; Whether to mention C function names along with Scheme procedure names. + (make-parameter #t)) + +(define (scheme-procedure-texi-line proc-name args + required-args optional-args + rest-arg?) + "Return a Texinfo string describing the Scheme procedure named +@var{proc-name}, whose arguments are listed in @var{args} (a list of strings) +and whose signature is defined by @var{required-args}, @var{optional-args} +and @var{rest-arg?}." + (string-append "@deffn {Scheme Procedure} " proc-name " " + (string-join (take args required-args) " ") + (string-join (take (drop args required-args) + (+ optional-args + (if rest-arg? 1 0))) + " [" 'prefix) + (if rest-arg? "...]" "") + (make-string optional-args #\]))) + +(define (procedure-gdf-string proc-doc) + "Issue a Texinfo/GDF docstring corresponding to @var{proc-doc}, a +documentation alist as returned by @code{parse-snarfed-line}. To produce +actual GDF-formatted doc, the resulting string must be processed by +@code{makeinfo}." + (let* ((proc-name (assq-ref proc-doc 'scheme-name)) + (args (assq-ref proc-doc 'arguments)) + (signature (assq-ref proc-doc 'signature)) + (required-args (assq-ref signature 'required)) + (optional-args (assq-ref signature 'optional)) + (rest-arg? (assq-ref signature 'rest?)) + (location (assq-ref proc-doc 'location)) + (file-name (car location)) + (line (cadr location)) + (documentation (assq-ref proc-doc 'documentation))) + (string-append " " ;; form feed + proc-name (string #\newline) + (format #f "@c snarfed from ~a:~a~%" + file-name line) + + (scheme-procedure-texi-line proc-name + (map schemify-name args) + required-args optional-args + rest-arg?) + + (string #\newline) + documentation (string #\newline) + "@end deffn" (string #\newline)))) + +(define (procedure-texi-documentation proc-doc) + "Issue a Texinfo docstring corresponding to @var{proc-doc}, a documentation +alist as returned by @var{parse-snarfed-line}. The resulting Texinfo string +is meant for use in a manual since it also documents the corresponding C +function." + (let* ((proc-name (assq-ref proc-doc 'scheme-name)) + (c-name (assq-ref proc-doc 'c-name)) + (args (assq-ref proc-doc 'arguments)) + (signature (assq-ref proc-doc 'signature)) + (required-args (assq-ref signature 'required)) + (optional-args (assq-ref signature 'optional)) + (rest-arg? (assq-ref signature 'rest?)) + (location (assq-ref proc-doc 'location)) + (file-name (car location)) + (line (cadr location)) + (documentation (assq-ref proc-doc 'documentation))) + (string-append (string #\newline) + (format #f "@c snarfed from ~a:~a~%" + file-name line) + + ;; document the Scheme procedure + (scheme-procedure-texi-line proc-name + (map schemify-name args) + required-args optional-args + rest-arg?) + (string #\newline) + + (if (*document-c-functions?*) + (string-append + ;; document the C function + "@deffnx {C Function} " c-name " (" + (if (null? args) + "void" + (string-join (map (lambda (arg) + (string-append "SCM " arg)) + args) + ", ")) + ")" (string #\newline)) + "") + + documentation (string #\newline) + "@end deffn" (string #\newline)))) + + +;;; +;;; Very high-level interface. +;;; + +(define (output-procedure-texi-documentation-from-c-file c-file cpp cflags + port) + (for-each (lambda (texi-string) + (display texi-string port)) + (map procedure-texi-documentation + (run-cpp-and-extract-snarfing c-file cpp cflags)))) + + +;;; output.scm ends here + +;;; Local Variables: +;;; mode: scheme +;;; coding: latin-1 +;;; End: + +;;; arch-tag: 20ca493a-6f1a-4d7f-9d24-ccce0d32df49 -- cgit v1.2.3