Skip to content
GitLab
Explore
Sign in
Register
Primary navigation
Search or go to…
Project
C
clx
Manage
Activity
Members
Labels
Plan
Issues
Issue boards
Milestones
Wiki
Code
Merge requests
Repository
Branches
Commits
Tags
Repository graph
Compare revisions
Build
Pipelines
Jobs
Pipeline schedules
Artifacts
Deploy
Releases
Model registry
Operate
Environments
Monitor
Incidents
Service Desk
Analyze
Value stream analytics
Contributor analytics
CI/CD analytics
Repository analytics
Model experiments
Help
Help
Support
GitLab documentation
Compare GitLab plans
Community forum
Contribute to GitLab
Provide feedback
Terms and privacy
Keyboard shortcuts
?
Snippets
Groups
Projects
Show more breadcrumbs
Alastair Bridgewater
clx
Commits
b6359115
Commit
b6359115
authored
21 years ago
by
csr21
Browse files
Options
Downloads
Patches
Plain Diff
Fix typesafety bugs in DEFINE-GCONTEXT-ACCESSOR
darcs-hash:20030625115504-ed5a3-8e1a89af106f69f94588df641457e22d23501f3f.gz
parent
68903efd
No related branches found
Branches containing commit
No related tags found
Tags containing commit
No related merge requests found
Changes
1
Hide whitespace changes
Inline
Side-by-side
Showing
1 changed file
gcontext.lisp
+7
-5
7 additions, 5 deletions
gcontext.lisp
with
7 additions
and
5 deletions
gcontext.lisp
+
7
−
5
View file @
b6359115
...
@@ -95,14 +95,16 @@
...
@@ -95,14 +95,16 @@
(
defstruct
(
gcontext-extension
(
:type
vector
)
(
:copier
nil
))
;; un-named
(
defstruct
(
gcontext-extension
(
:type
vector
)
(
:copier
nil
))
;; un-named
(
name
nil
:type
symbol
:read-only
t
)
(
name
nil
:type
symbol
:read-only
t
)
(
default
nil
:type
t
:read-only
t
)
(
default
nil
:type
t
:read-only
t
)
;; FIXME: these used to have glorious, but wrong, type declarations.
;; See if we can't return them to their former glory.
(
set-function
#'
(
lambda
(
gcontext
value
)
(
set-function
#'
(
lambda
(
gcontext
value
)
(
declare
(
ignore
gcontext
))
(
declare
(
ignore
gcontext
))
value
)
value
)
:type
(
function
(
gcontext
t
)
t
)
:read-only
t
)
:type
(
or
function
symbol
)
:read-only
t
)
(
copy-function
#'
(
lambda
(
from-gc
to-gc
value
)
(
copy-function
#'
(
lambda
(
from-gc
to-gc
value
)
(
declare
(
ignore
from-gc
to-gc
))
(
declare
(
ignore
from-gc
to-gc
))
value
)
value
)
:type
(
function
(
gcontext
gcontext
t
)
t
)
:read-only
t
))
:type
(
or
function
symbol
)
:read-only
t
))
(
defvar
*gcontext-extensions*
nil
)
;; list of gcontext-extension
(
defvar
*gcontext-extensions*
nil
)
;; list of gcontext-extension
...
@@ -904,7 +906,7 @@
...
@@ -904,7 +906,7 @@
(
declare
(
type
symbol
name
)
(
declare
(
type
symbol
name
)
(
type
t
default
)
(
type
t
default
)
(
type
symbol
set-function
)
;; required
(
type
symbol
set-function
)
;; required
(
type
symbol
copy-function
))
(
type
(
or
symbol
list
)
copy-function
))
(
let*
((
gc-name
(
intern
(
concatenate
'string
(
let*
((
gc-name
(
intern
(
concatenate
'string
(
string
'gcontext-
)
(
string
'gcontext-
)
(
string
name
))))
;; in current package
(
string
name
))))
;; in current package
...
@@ -957,8 +959,8 @@
...
@@ -957,8 +959,8 @@
(
defun
add-gcontext-extension
(
name
default-value
set-function
copy-function
)
(
defun
add-gcontext-extension
(
name
default-value
set-function
copy-function
)
(
declare
(
type
symbol
name
)
(
declare
(
type
symbol
name
)
(
type
t
default-value
)
(
type
t
default-value
)
(
type
(
function
(
gcontext
t
)
t
)
set-function
)
(
type
(
or
function
symbol
)
set-function
)
(
type
(
function
(
gcontext
gcontext
t
)
t
)
copy-function
))
(
type
(
or
function
symbol
)
copy-function
))
(
let
((
number
(
or
(
position
name
*gcontext-extensions*
:key
#'
gcontext-extension-name
)
(
let
((
number
(
or
(
position
name
*gcontext-extensions*
:key
#'
gcontext-extension-name
)
(
prog1
(
length
*gcontext-extensions*
)
(
prog1
(
length
*gcontext-extensions*
)
(
push
nil
*gcontext-extensions*
)))))
(
push
nil
*gcontext-extensions*
)))))
...
...
This diff is collapsed.
Click to expand it.
Preview
0%
Loading
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Save comment
Cancel
Please
register
or
sign in
to comment