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