summaryrefslogtreecommitdiff
path: root/scripts/annotate-api-groupings
blob: 56b139d506f42ecadeae00e25b16cbd2f3a1a007 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
#!/bin/sh
# aside from this initial boilerplate, this is actually -*- scheme -*- code
main='(module-ref (resolve-module '\''(scripts annotate-api-groupings)) '\'main')'
exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@"
!#
;;; annotate-api-groupings --- Add grouping annotations to API elements

;; 	Copyright (C) 2002 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 2, 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 software; see the file COPYING.  If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
;; Boston, MA 02111-1307 USA

;;; Author: Thien-Thi Nguyen <ttn@gnu.org>

;;; Commentary:

;; Usage: annotate-api-groupings GUILE-API GROUPINGS
;;
;; This progrsm reads GUILE-API and GROUPINGS files, and writes to stdout
;; each element in the API annotated with the groupings. [[format still in
;; development -- subject to change after feedback.]]
;;
;; TODO: Finish commentary.
;;       Finalize format.
;;       Perhaps push back on input format since "Scheme" or "C"
;;         parents can be also treated as (a priori) groupings.

;;; Code:

(define-module (scripts annotate-api-groupings)
  :autoload (ice-9 regex) (string-match)
  :export (annotate-api-groupings))

(define THIS-MODULE (current-module))

(define (in-group? x group)
  (memq group (assq-ref x 'groups)))

(define (name-prefix? x prefix)
  (let ((s (symbol->string (car x))))
    (string-match (string-append "^" prefix) s)))

(define (add-group-name! x name)
  (let ((g (assq 'groups (cdr x))))
    (set-cdr! g (cons name (cdr g)))))

(define (make-grok-hook name form)
  (let ((predicate? (eval form THIS-MODULE)))
    (lambda (x)
      (and (predicate? x)
           (add-group-name! x name)))))

(define (make-members-hook name members)
  (lambda (x)
    (and (memq (car x) members)
         (add-group-name! x name))))

(define (process-groupings groupings all)
  (let ((hook (make-hook 1)))
    (for-each (lambda (gdef)
                (let ((name (car gdef))
                      (members (assq-ref gdef 'members))
                      (grok (assq-ref gdef 'grok)))
                  (format #t ";;; grouping: ~A ~A (~A)\n"
                          name
                          (assq-ref gdef 'description)
                          (if grok 'grok 'members))
                  (or members grok
                      (error "bad grouping, must have `members' or `grok'"))
                  (add-hook! hook
                             (if grok
                                 (make-grok-hook name (cadr grok))
                                 (make-members-hook name members)))))
              groupings)
    (for-each (lambda (x)
                (run-hook hook x))
              all))
  all)

(define (annotate-api-groupings . args)
  (let* ((alist (read (open-file (car args) "r")))
         (meta (assq 'meta alist))
         (all (let* ((tag! (lambda (x tag)
                             (set-cdr! x (list `(groups ,tag)
                                               `(scan-data ,@(cdr x))))))
                     (inv! (lambda (lang)
                             (for-each (lambda (x) (tag! x lang))
                                       (assq-ref alist lang))
                             (assq-ref alist lang))))
                (append (inv! 'scheme)
                        (inv! 'C))))
         (groupings (read (open-file (cadr args) "r")))
         (new-all (process-groupings groupings all)))
    ;; TODO
    (for-each (lambda (x)
                (format #t "~S\n" x))
              new-all))
  #t)

(define main annotate-api-groupings)

;;; annotate-api-groupings ends here