[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[gnunet-scheme] 55/324: enum: implement docstrings and general niceness
From: |
gnunet |
Subject: |
[gnunet-scheme] 55/324: enum: implement docstrings and general niceness |
Date: |
Tue, 21 Sep 2021 13:21:35 +0200 |
This is an automated email from the git hooks/post-receive script.
maxime-devos pushed a commit to branch master
in repository gnunet-scheme.
commit c7fb58ed3faf821d514f596ca1e737657b2e93b6
Author: Maxime Devos <maximedevos@telenet.be>
AuthorDate: Wed Jan 27 19:55:54 2021 +0100
enum: implement docstrings and general niceness
This breaks the libextractor port, and directory creation
-- will be fixed later. The new enumeration module supports
defining docstrings, (untested) source line numbers and
symbol<->typed value<->integer conversion.
Somthing to do later: rename gnu/extractor/enum.scm to
something else.
* gnu/extractor/enum.scm: rewrite
---
gnu/extractor/enum.scm | 257 +++++++++++++++++++++++++++++++++++++++++++------
1 file changed, 227 insertions(+), 30 deletions(-)
diff --git a/gnu/extractor/enum.scm b/gnu/extractor/enum.scm
index d3af6a7..0f0498c 100644
--- a/gnu/extractor/enum.scm
+++ b/gnu/extractor/enum.scm
@@ -1,7 +1,7 @@
;; This file is part of scheme-GNUnet, a partial Scheme port of GNUnet
;; scheme-GNUnet contains scheme-extractor.
;; scheme-extractor is a partial Scheme port of libextractor.
-;; Copyright (C) 2020 Maxime Devos
+;; Copyright (C) 2020, 2021 Maxime Devos
;;
;; libextractor is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published
@@ -19,33 +19,230 @@
;; Boston, MA 02110-1301, USA.
;; Brief: typed C-like enums
-;; TODO: pretty-printing and debugging information
-;; Note: this is an internal module, subject to change
-(library (gnu extractor enum)
- (export define-wrapped-enum)
- (import (rnrs base)
+;; Features:
+;; * typed
+;; * integer and symbol conversion
+;; * source line information (bug: isn't registered for some reason)
+;; * docstrings
+;; * enum values can be compared with eq?
+;; (unless they aren't defined, in which
+;; one must compare the indices directly,
+;; or with value=?)
+
+(define-library (gnu extractor enum)
+ (export value->index value->symbol value-dynamic?
+ value-documentation value-source
+ value-enum
+ enum-name enum-max-value enum-predefined-values
+ enum-source enum-docstring
+ integer->value symbol->value symbol-value
+ value enumeration define-enumeration
+ value=?)
+ (import (only (guile)
+ write newline display
+ syntax-source assq-ref compose
+ resolve-module module-ref
+ raise-exception)
+ (only (system syntax) syntax-local-binding)
+ (system vm program)
+ (ice-9 format)
+ (only (srfi srfi-9 gnu)
+ set-record-type-printer!)
+ (except (srfi srfi-1) map)
+ (srfi srfi-26)
+ (except (srfi srfi-43) vector-map)
+ (rnrs base)
+ ;;map vector-map)
+ (rnrs control)
+ (rnrs syntax-case)
(rnrs records syntactic))
- (define-syntax define-wrapped-enum
- (syntax-rules (#;max #;known)
- ((_ (<wrapped> wrapped? integer-> ->integer)
- (#:max maximum)
- (#:known (name value) ...))
- (begin
- (define-record-type (<wrapped> %make-wrapped wrapped?)
- (fields (immutable unwrapped ->integer))
- (sealed #t)
- (opaque #t))
-
- (define (integer-> index)
- ;; TODO: more descriptive exceptions
- (assert (and (exact? index) (integer? index)))
- (assert (and (<= 0 index) (<= index maximum)))
- (%make-wrapped index))
-
- ;; Warning: this may be defined as syntax in the future!
- ;; (equal? <wrapped> are not necessarily eq?,
- ;; and a fresh <wrapped> may be generated each time).
- ;;
- ;; TODO: verify integer-hood at compile-time
- (define name (integer-> value))
- ...)))))
+ (begin
+ (define-record-type (<value> %make-value value?)
+ ;; Numeric value
+ (fields (immutable index value->index)
+ ;; Symbolic name (or #f)
+ (immutable symbol value->symbol)
+ ;; Is this predefined (so eq? can be used),
+ ;; or dynamically generated (so equal? must be used)?
+ (immutable dynamic? value-dynamic?)
+ ;; Docstring (or #f)
+ (immutable docstring value-documentation)
+ ;; thunked <enum>
+ (immutable part-of value-enum-thunk)
+ ;; Source location (or #f)
+ (immutable source value-source))
+ (sealed #t)
+ (opaque #t))
+
+ (define (value=? x y)
+ "Compare two values of the same enumeration."
+ (assert (eq? ((value-enum-thunk x))
+ ((value-enum-thunk y))))
+ (= (value->index x)
+ (value->index y)))
+
+ (define (value-enum enum)
+ "To which enumeration does @var{enum} belong?"
+ (let ((t (value-enum-thunk enum)))
+ (if t (t) #f)))
+
+ ;; FIXME variant if enum is sparse
+ (define-record-type (<enum> %make-enum enum?)
+ (fields (immutable max enum-max-value)
+ (immutable symbol enum-name)
+ (immutable values enum-predefined-values)
+ (immutable source enum-source)
+ (immutable docstring enum-docstring))
+ (sealed #t)
+ (opaque #t))
+
+ ;; Make sure record printing terminates.
+ ;; Also include line numbers, and remove
+ ;; uninteresting data (and data that takes
+ ;; too much space).
+ (set-record-type-printer!
+ <value>
+ (lambda (record port)
+ (let ((sources (value-source record)))
+ (if sources
+ (format port "#<value (~a ~a) index: ~a at ~a:~a:~a>"
+ (enum-name ((value-enum-thunk record)))
+ (value->symbol record)
+ (value->index record)
+ (source:file sources)
+ (source:line sources)
+ (source:column sources))
+ (format port "#<value (~a ~a) index: ~a>"
+ (enum-name ((value-enum-thunk record)))
+ (value->symbol record)
+ (value->index record))))))
+
+ (set-record-type-printer!
+ <enum>
+ (lambda (record port)
+ (let ((sources (enum-source record)))
+ (if sources
+ (format port "#<enum ~a (max: ~a) at ~a:~a:~a>"
+ (enum-name record)
+ (enum-max-value record)
+ (source:file sources)
+ (source:line sources)
+ (source:column sources))
+ (format port "<enum ~a (max: ~a)>"
+ (enum-name record)
+ (enum-max-value record))))))
+
+ (define (%make-enum/fix max symbol values-proc source docstring)
+ (letrec ((e (%make-enum max symbol
+ (vector-map (lambda (vproc)
+ (vproc (lambda () e)))
+ values-proc)
+ source docstring)))
+ e))
+
+ (define (integer->value enum i)
+ (assert (and (exact? i) (integer? i)))
+ (assert (<= 0 i))
+ (assert (< i (enum-max-value enum)))
+ (if (< i (enum-max-value enum))
+ (vector-ref (enum-predefined-values enum) i)
+ (%make-value i #f #t #f #f #f)))
+
+ ;; Slow
+ (define (symbol->value enum s)
+ "Return the enum value in @var{enum} with symbol @var{s},
+or #f it doesn't exist."
+ (let ((i (vector-index (compose (cute eq? s <>) value->symbol)
+ (enum-predefined-values enum))))
+ (vector-ref (enum-predefined-values enum) i)))
+
+ ;; Returned code is fast.
+ (define-syntax symbol-value
+ (lambda (x)
+ "Takes a (name of) a enumeration @var{enum} and literal symbol
+@var{s} in that, and expands to an expression returning the enumeration
+value. Due to technical reasons, @var{enum} must be a binding from a
+module, and @var{enum} must be defined the same in the build and host."
+ (syntax-case x ()
+ ((_ enum s)
+ (let-values (((type info) (syntax-local-binding #'enum)))
+ (case type
+ ((global)
+ (let* ((module (resolve-module (cdr info)))
+ (enum@host (module-ref module (car info)))
+ (value@host (symbol->value enum@host
+ (syntax->datum #'s)))
+ (index (value->index value@host)))
+ #`(vector-ref (enum-predefined-values enum) #,index)))
+ (else (raise-exception
+ (syntax-violation 'symbol-value
+ "@var{enum} is not a global variable"
+ x
+ #'enum)))))))))
+
+ (define (syntax->list s)
+ (syntax-case s ()
+ (() '())
+ ((x . rest)
+ (cons #'x (syntax->list #'rest)))))
+
+ (define-syntax value
+ (lambda (s)
+ (syntax-case s ()
+ ((_ (x y) ...)
+ (let* ((key-value
+ (zip (map syntax->datum (syntax->list #'(x ...)))
+ (syntax->list #'(y ...))))
+ (index/syntax (assq-ref key-value 'index))
+ (index (car (syntax->datum index/syntax)))
+ (symbol/syntax (assq-ref key-value 'symbol))
+ (symbol (if symbol/syntax
+ (car (syntax->datum symbol/syntax))
+ #f))
+ (docstring/syntax
+ (assq-ref key-value 'documentation))
+ (docstring (if docstring/syntax
+ (car (syntax->datum docstring/syntax))
+ #f)))
+ (assert (and (exact? index) (integer? index)))
+ (when symbol
+ (assert (symbol? symbol)))
+ (when docstring
+ (assert (string? docstring)))
+ #`(lambda (thunk)
+ (%make-value #,index
+ '#,(datum->syntax s symbol)
+ #f
+ #,docstring
+ thunk
+ #,(syntax-source s))))))))
+
+ ;; TODO verify indices are correct
+ (define-syntax enumeration
+ (lambda (s)
+ (syntax-case s ()
+ ((_ (name)
+ (#:documentation doc)
+ (#:max maximum)
+ (#:known entry ...))
+ #`(%make-enum/fix 'maximum
+ 'name
+ (vector entry ...)
+ #,(syntax-source s)
+ doc)))))
+
+ (define-syntax define-enumeration
+ (syntax-rules ()
+ ((_ (name enum-value?)
+ (#:documentation doc)
+ (#:max maximum)
+ (#:known entry ...))
+ (begin
+ (define name
+ (enumeration (name)
+ (#:documentation doc)
+ (#:max maximum)
+ (#:known entry ...)))
+ (define (enum-value? o)
+ (and (value? o)
+ (eq? name ((value-enum-thunk o)))))))))))
--
To stop receiving notification emails like this one, please contact
gnunet@gnunet.org.
- [gnunet-scheme] 52/324: scripts: download-store: add downloading procedure, (continued)
- [gnunet-scheme] 52/324: scripts: download-store: add downloading procedure, gnunet, 2021/09/21
- [gnunet-scheme] 47/324: scripts: publish-store: don't index temporary files, gnunet, 2021/09/21
- [gnunet-scheme] 50/324: scripts: download-store: (partially) validate entries, gnunet, 2021/09/21
- [gnunet-scheme] 49/324: scripts: publish-store: correct file name creation, gnunet, 2021/09/21
- [gnunet-scheme] 57/324: mq: define priority and preference values, gnunet, 2021/09/21
- [gnunet-scheme] 59/324: Fix value creation in integer->value, gnunet, 2021/09/21
- [gnunet-scheme] 54/324: Add missing dependency ‘guix-stuff.scm’, gnunet, 2021/09/21
- [gnunet-scheme] 62/324: Change e-mail address, gnunet, 2021/09/21
- [gnunet-scheme] 58/324: scripts: publish-store: use SRFI-39 parameters for configuration, gnunet, 2021/09/21
- [gnunet-scheme] 61/324: Write code for message handlers, gnunet, 2021/09/21
- [gnunet-scheme] 55/324: enum: implement docstrings and general niceness,
gnunet <=
- [gnunet-scheme] 56/324: Define many GNUnet message types., gnunet, 2021/09/21
- [gnunet-scheme] 69/324: doc: Update ROADMAP with steps to do, gnunet, 2021/09/21
- [gnunet-scheme] 63/324: Define message envelope type and procedures., gnunet, 2021/09/21
- [gnunet-scheme] 73/324: concurrency: implement an ‘update stream’, gnunet, 2021/09/21
- [gnunet-scheme] 81/324: nse: define network structures., gnunet, 2021/09/21
- [gnunet-scheme] 74/324: build: add autotools scripts, gnunet, 2021/09/21
- [gnunet-scheme] 78/324: scripts: download-store: remove debugging, gnunet, 2021/09/21
- [gnunet-scheme] 60/324: Allow using integer->value on maximal value, gnunet, 2021/09/21
- [gnunet-scheme] 68/324: scripts: download-store: allow downloads in nar format, gnunet, 2021/09/21
- [gnunet-scheme] 67/324: scripts: Don't flatten the FS tree and use SXML instead of JSON, gnunet, 2021/09/21