maint/update-enumerations

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