Skip to content
GitLab
Explore
Sign in
Register
Primary navigation
Search or go to…
Project
cmucl
Manage
Activity
Members
Labels
Plan
Issues
Issue boards
Milestones
Wiki
Code
Merge requests
Repository
Branches
Commits
Tags
Repository graph
Compare revisions
Snippets
Build
Pipelines
Jobs
Pipeline schedules
Artifacts
Deploy
Releases
Package Registry
Container Registry
Model registry
Operate
Environments
Terraform modules
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
Tarn Burton
cmucl
Commits
9581820a
Commit
9581820a
authored
1 year ago
by
Raymond Toy
Browse files
Options
Downloads
Patches
Plain Diff
Address #240: Clean up hashtable implementation of set functions
parent
a5b2c0f8
No related branches found
Branches containing commit
No related tags found
No related merge requests found
Changes
1
Hide whitespace changes
Inline
Side-by-side
Showing
1 changed file
src/code/list.lisp
+26
-42
26 additions, 42 deletions
src/code/list.lisp
with
26 additions
and
42 deletions
src/code/list.lisp
+
26
−
42
View file @
9581820a
...
@@ -750,6 +750,28 @@
...
@@ -750,6 +750,28 @@
15
)
15
)
(
declaim
(
start-block
list-to-hashtable
union
intersection
set-difference
))
(
declaim
(
start-block
list-to-hashtable
union
intersection
set-difference
))
;; Main code to process a set function. INIT-RES initializes the
;; value of RES, which holds the result of the set function.
;; TEST-FORM is a form that tests whether to add the item from LIST1
;; to RES.
(
defmacro
process-set-body
(
init-res
invert-p
test-form
)
`
(
let
((
res
,
init-res
))
(
dolist
(
item
list1
)
(
when
,
(
if
invert-p
`
(
not
,
test-form
)
test-form
)
(
push
item
res
)))
res
))
(
defmacro
process-set
(
init-res
invert-p
)
`
(
let
((
hashtable
(
list-to-hashtable
list2
key
test
test-not
)))
(
if
hashtable
(
process-set-body
,
init-res
,
invert-p
(
nth-value
1
(
gethash
(
apply-key
key
item
)
hashtable
)))
(
process-set-body
,
init-res
,
invert-p
(
with-set-keys
(
member
(
apply-key
key
item
)
list2
))))))
;; Convert a list to a hashtable. The hashtable does not handle
;; Convert a list to a hashtable. The hashtable does not handle
;; duplicated values in the list. Returns the hashtable.
;; duplicated values in the list. Returns the hashtable.
(
defun
list-to-hashtable
(
list
key
test
test-not
)
(
defun
list-to-hashtable
(
list
key
test
test-not
)
...
@@ -791,17 +813,7 @@
...
@@ -791,17 +813,7 @@
(
declare
(
inline
member
))
(
declare
(
inline
member
))
(
when
(
and
testp
notp
)
(
when
(
and
testp
notp
)
(
error
(
intl:gettext
"Test and test-not both supplied."
)))
(
error
(
intl:gettext
"Test and test-not both supplied."
)))
(
let
((
res
list2
)
(
process-set
list2
t
))
(
hashtable
(
list-to-hashtable
list2
key
test
test-not
)))
(
cond
(
hashtable
(
dolist
(
item
list1
)
(
unless
(
nth-value
1
(
gethash
(
apply-key
key
item
)
hashtable
))
(
push
item
res
))))
((
null
hashtable
)
(
dolist
(
item
list1
)
(
unless
(
with-set-keys
(
member
(
apply-key
key
item
)
list2
))
(
push
item
res
)))))
res
))
(
defun
intersection
(
list1
list2
&key
key
(
defun
intersection
(
list1
list2
&key
key
...
@@ -810,20 +822,7 @@
...
@@ -810,20 +822,7 @@
(
declare
(
inline
member
))
(
declare
(
inline
member
))
(
if
(
and
testp
notp
)
(
if
(
and
testp
notp
)
(
error
"Test and test-not both supplied."
))
(
error
"Test and test-not both supplied."
))
(
let
((
hashtable
(
process-set
nil
nil
))
(
list-to-hashtable
list2
key
test
test-not
)))
(
cond
(
hashtable
(
let
((
res
nil
))
(
dolist
(
item
list1
)
(
when
(
nth-value
1
(
gethash
(
apply-key
key
item
)
hashtable
))
(
push
item
res
)))
res
))
((
null
hashtable
)
(
let
((
res
nil
))
(
dolist
(
elt
list1
)
(
if
(
with-set-keys
(
member
(
apply-key
key
elt
)
list2
))
(
push
elt
res
)))
res
)))))
(
defun
set-difference
(
list1
list2
&key
key
(
test
#'
eql
testp
)
(
test-not
nil
notp
))
(
defun
set-difference
(
list1
list2
&key
key
(
test
#'
eql
testp
)
(
test-not
nil
notp
))
"Returns the elements of list1 which are not in list2."
"Returns the elements of list1 which are not in list2."
...
@@ -834,23 +833,8 @@
...
@@ -834,23 +833,8 @@
(
when
(
null
list2
)
(
when
(
null
list2
)
(
return-from
set-difference
list1
))
(
return-from
set-difference
list1
))
(
let
((
hashtable
(
process-set
nil
t
))
(
list-to-hashtable
list2
key
test
test-not
)))
(
cond
(
hashtable
;; list2 was placed in hash table.
(
let
((
res
nil
))
(
dolist
(
item
list1
)
(
unless
(
nth-value
1
(
gethash
(
apply-key
key
item
)
hashtable
))
(
push
item
res
)))
res
))
((
null
hashtable
)
;; Default implementation because we didn't create the hash
;; table.
(
let
((
res
nil
))
(
dolist
(
item
list1
)
(
if
(
not
(
with-set-keys
(
member
(
apply-key
key
item
)
list2
)))
(
push
item
res
)))
res
)))))
(
declaim
(
end-block
))
(
declaim
(
end-block
))
...
...
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