maint/update-enumerations

   1 #!/usr/bin/env guile
   2 !#
   3
   4 (use-modules (figl parse)
   5              (figl config)
   6              (ice-9 match)
   7              (sxml fold)
   8              ((srfi srfi-1) #:select (append-map))
   9              (texinfo serialize)
  10              (texinfo plain-text)
  11              (ice-9 pretty-print))
  12
  13 (setlocale LC_ALL "")
  14
  15 (print-disable 'escape-newlines)
  16
  17 (define (list-intersperse src-l elem)
  18   (if (null? src-l) src-l
  19       (let loop ((l (cdr src-l)) (dest (cons (car src-l) '())))
  20         (if (null? l) (reverse dest)
  21             (loop (cdr l) (cons (car l) (cons elem dest)))))))
  22
  23 (define (module-name->scm-name mod-name)
  24   (string-join (list (abs-top-srcdir)
  25                      "figl"
  26                      (symbol->string mod-name)
  27                      "enums.scm")
  28                "/"))
  29
  30 (define (module-name->texi-name mod-name)
  31   (in-vicinity
  32    (in-vicinity (abs-top-srcdir) "doc")
  33    (string-append "low-level-" (symbol->string mod-name) "-enums.texi")))
  34
  35 (define (strip-bit name)
  36   (let ((str (symbol->string name)))
  37     (cond
  38      ((string-suffix? "-bit" str)
  39       (string->symbol (substring str 0 (- (string-length str) 4))))
  40      ((string-suffix? "-bits" str)
  41       (string->symbol (substring str 0 (- (string-length str) 5))))
  42      (else #f))))
  43
  44 (define (bitfield? enum)
  45   (and-map (match-lambda ((name . value) (strip-bit name)))
  46            (gl-enumeration-values enum)))
  47
  48 (define (write-scm mod-name enums port)
  49   (display "\
  50 ;;; figl                           -*- mode: scheme; coding: utf-8 -*-
  51 ;;; Copyright (C) 2013 Andy Wingo <wingo@pobox.com>
  52 ;;;
  53 ;;; Figl is free software: you can redistribute it and/or modify it
  54 ;;; under the terms of the GNU Lesser General Public License as
  55 ;;; published by the Free Software Foundation, either version 3 of the
  56 ;;; License, or (at your option) any later version.
  57 ;;;
  58 ;;; Figl is distributed in the hope that it will be useful, but WITHOUT
  59 ;;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
  60 ;;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General
  61 ;;; Public License for more details.
  62 ;;;
  63 ;;; You should have received a copy of the GNU Lesser General Public
  64 ;;; License along with this program.  If not, see
  65 ;;; <http://www.gnu.org/licenses/>.
  66 ;;;
  67 ;;; Derived from the API specifications at www.opengl.org/registry/api/.
  68 ;;;
  69 ;;; Automatically generated; you probably don't want to edit this.  To
  70 ;;; update, run \"make update-enums\" in the top-level build tree.
  71 ;;;
  72
  73 " port)
  74   (pretty-print
  75    `(define-module (figl ,mod-name enums)
  76       #:use-module (figl runtime)
  77       #:export ,(map gl-enumeration-category enums))
  78    port)
  79   (newline port)
  80   (for-each
  81    (lambda (enum)
  82      (pretty-print
  83       (if (bitfield? enum)
  84           `(define-bitfield ,(gl-enumeration-category enum)
  85              ,@(map (match-lambda
  86                      ((name . value) (list (strip-bit name) value)))
  87                     (gl-enumeration-values enum)))
  88           `(define-enumeration ,(gl-enumeration-category enum)
  89              ,@(map (match-lambda
  90                      ((name . value) (list name value)))
  91                     (gl-enumeration-values enum))))
  92       port)
  93      (newline port))
  94    enums))
  95
  96 (define (write-texi mod-name enums port)
  97   (display
  98    (stexi->texi
  99     `(*fragment*
 100       (para "The functions from this section may be had by loading "
 101             "the module:")
 102       (example "(use-modules (figl " ,(object->string mod-name) " enums)")
 103       ,@(map
 104          (lambda (enum)
 105            (if (bitfield? enum)
 106                `(defmac (% (name ,(symbol->string (gl-enumeration-category enum)))
 107                            (arguments "bit..."))
 108                   (para
 109                    "Bitfield constructor.  The symbolic " (var "bit")
 110                    " arguments are replaced with their corresponding numeric "
 111                    "values and combined with " (code "logior") " at "
 112                    "compile-time.  The symbolic arguments known to this "
 113                    "bitfield constructor are:")
 114                   (para
 115                    ,@(list-intersperse
 116                       (map (lambda (name)
 117                              `(code ,(symbol->string (strip-bit name))))
 118                            (map car (gl-enumeration-values enum)))
 119                      ", ")
 120                    "."))
 121                `(defmac (% (name ,(symbol->string (gl-enumeration-category enum)))
 122                            (arguments "enum"))
 123                   (para
 124                    "Enumerated value.  The symbolic " (var "enum") "argument "
 125                    "is replaced with its corresponding numeric value at "
 126                    "compile-time.  The symbolic arguments known to this "
 127                    "enumerated value form are:")
 128                   (para
 129                    ,@(list-intersperse
 130                       (map (lambda (name) `(code ,(symbol->string name)))
 131                            (map car (gl-enumeration-values enum)))
 132                      ", ")
 133                    "."))))
 134          enums)))
 135    port))
 136
 137 (define (write-enumerations mod-name enums)
 138   (call-with-output-file (module-name->scm-name mod-name)
 139     (lambda (port)
 140       (write-scm mod-name enums port)))
 141   (call-with-output-file (module-name->texi-name mod-name)
 142     (lambda (port)
 143       (write-texi mod-name enums port))))
 144
 145 (define* (main arg0)
 146   (write-enumerations 'gl (parse-gl-enumerations "enum.spec"))
 147   (write-enumerations 'glx (parse-gl-enumerations "glxenum.spec")))
 148
 149 (when (batch-mode?)
 150   (apply main (command-line)))