Skip to content

Require user-expressed type for all flag definitions #16

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
copybara-service merged 1 commit into from
Jun 30, 2026
Merged

Require user-expressed type for all flag definitions #16

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
7 changes: 6 additions & 1 deletion flag-test.lisp
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -23,7 +23,12 @@
;;; All the tests except one expect that NAME gets defined via DEFPARAMETER,
;;; whereas by default the flag can't be LET-bound.
(defmacro test-define (name val doc &rest rest)
`(flag:define ,name ,val ,doc :def defparameter ,@rest))
(if (getf rest :type)
`(flag:define ,name ,val ,doc :def defparameter ,@rest)
(let ((assumed-type (cond ((stringp val) 'string)
((integerp val) 'integer)
(t (type-of val)))))
`(flag:define ,name ,val ,doc :def defparameter :type ,assumed-type ,@rest))))

(test-define *boolean* t "Test boolean flag.")

Expand Down
14 changes: 4 additions & 10 deletions flag.lisp
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -128,6 +128,8 @@
(fail "The name ~S of the flag is not a string or symbol." flag))
(unless (typep doc 'string)
(fail "The flag ~S requires a help string." doc))
(unless type
(fail "Flag definition ~S lacks a :TYPE" flag))
(unless (typep type '(or symbol cons))
(fail "The type of flag ~S needs to be a proper type specifier. Provided: ~S." flag type))
(dolist (name names)
Expand Down Expand Up @@ -169,14 +171,6 @@
(value (macro:gensym* :value))
(specified-type type))

(unless type
;; Derive type from the type of the default argument.
(let ((declaimed (type:declaimed flag)))
(setf type (cond ((not (member declaimed '(t nil)))
declaimed)
((constantp default)
(type:upgraded-type-of (eval default))) ; NOLINT
(t nil)))))
`(progn
(let ((nullable (typep nil ',type)))
(register ',flag ',provided-names nullable *flags*)
Expand Down Expand Up @@ -355,7 +349,7 @@ Parameters:
(let* ((flag (first flag+names))
(names (sort (rest flag+names) #'string<))
(doc (documentation flag 'variable))
(type (or (get flag 'specified-type) (type:declaimed flag)))
(type (or (get flag 'specified-type) (error "can't call type:declaimed on ~S" flag)))
(value (and (boundp flag) (symbol-value flag)))
(long-form (or long-form (cdr names)))
(flag-package (symbol-package flag)))
Expand Down Expand Up @@ -448,7 +442,7 @@ Parameters:
(declare (self (symbol (or null string) &key boolean boolean)
(or cons symbol) t boolean boolean))
(let* ((specified-type (get variable 'specified-type))
(type (or specified-type (type:declaimed variable)))
(type (or specified-type (error "can't call type:declaimed on ~S" variable)))
(parser (get variable 'parser)))

(cond ((and no-p (typep nil type))
Expand Down