Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
ecl
ecl
Commits
9c2aef55
Commit
9c2aef55
authored
Apr 30, 2017
by
Daniel Kochmański
Browse files
packages: add local-nicknames to the internal structure
adjust internal functions to accept the argument.
parent
82a50e9c
Changes
7
Hide whitespace changes
Inline
Side-by-side
src/c/main.d
View file @
9c2aef55
...
...
@@ -556,43 +556,54 @@ cl_boot(int argc, char **argv)
cl_core
.
lisp_package
=
ecl_make_package
(
str_common_lisp
,
cl_list
(
2
,
str_cl
,
str_LISP
),
ECL_NIL
,
ECL_NIL
);
cl_core
.
user_package
=
ecl_make_package
(
str_common_lisp_user
,
cl_list
(
2
,
str_cl_user
,
str_user
),
ecl_list1
(
cl_core
.
lisp_package
));
ecl_list1
(
cl_core
.
lisp_package
),
ECL_NIL
);
cl_core
.
keyword_package
=
ecl_make_package
(
str_keyword
,
ECL_NIL
,
ECL_NIL
);
ecl_make_package
(
str_keyword
,
ECL_NIL
,
ECL_NIL
,
ECL_NIL
);
cl_core
.
ext_package
=
ecl_make_package
(
str_ext
,
ECL_NIL
,
ecl_list1
(
cl_core
.
lisp_package
));
ecl_make_package
(
str_ext
,
ECL_NIL
,
ecl_list1
(
cl_core
.
lisp_package
),
ECL_NIL
);
cl_core
.
system_package
=
ecl_make_package
(
str_si
,
cl_list
(
2
,
str_system
,
str_sys
),
cl_list
(
2
,
cl_core
.
ext_package
,
cl_core
.
lisp_package
));
cl_core
.
lisp_package
),
ECL_NIL
);
cl_core
.
c_package
=
ecl_make_package
(
str_c
,
ecl_list1
(
str_compiler
),
ecl_list1
(
cl_core
.
lisp_package
));
ecl_list1
(
cl_core
.
lisp_package
),
ECL_NIL
);
cl_core
.
clos_package
=
ecl_make_package
(
str_clos
,
ecl_list1
(
str_mop
),
ecl_list1
(
cl_core
.
lisp_package
));
ecl_list1
(
cl_core
.
lisp_package
),
ECL_NIL
);
cl_core
.
mp_package
=
ecl_make_package
(
str_mp
,
ecl_list1
(
str_multiprocessing
),
ecl_list1
(
cl_core
.
lisp_package
));
ecl_list1
(
cl_core
.
lisp_package
),
ECL_NIL
);
#
ifdef
ECL_CLOS_STREAMS
cl_core
.
gray_package
=
ecl_make_package
(
str_gray
,
ECL_NIL
,
CONS
(
cl_core
.
lisp_package
,
ECL_NIL
));
cl_core
.
gray_package
=
ecl_make_package
(
str_gray
,
ECL_NIL
,
ecl_list1
(
cl_core
.
lisp_package
),
ECL_NIL
);
#
endif
cl_core
.
ffi_package
=
ecl_make_package
(
str_ffi
,
ECL_NIL
,
cl_list
(
3
,
cl_core
.
lisp_package
,
cl_core
.
system_package
,
cl_core
.
ext_package
));
cl_core
.
ext_package
),
ECL_NIL
);
ECL_NIL_SYMBOL
->
symbol
.
hpack
=
cl_core
.
lisp_package
;
cl_import2
(
ECL_NIL
,
cl_core
.
lisp_package
);
...
...
src/c/package.d
View file @
9c2aef55
...
...
@@ -95,11 +95,12 @@ symbol_add_package(cl_object s, cl_object p)
}
/*
ecl_make_package(n, ns, ul) makes a package with name n,
which must be a string or a symbol,
and nicknames ns, which must be a list of strings or symbols,
and uses packages in list ul, which must be a list of packages
or package names i.e. strings or symbols.
ecl_make_package(n, ns, ul, lns) makes a package with name n, which
must be a string or a symbol, and nicknames ns, which must be a list
of strings or symbols, and uses packages in list ul, which must be a
list of packages or package names i.e. strings or symbols. lns is an
alist (local-nickname . package) which is used for having private
nicknames for other packages.
*/
static
cl_object
make_package_hashtable
()
...
...
@@ -118,6 +119,7 @@ alloc_package(cl_object name)
p
->
pack
.
external
=
make_package_hashtable
();
p
->
pack
.
name
=
name
;
p
->
pack
.
nicknames
=
ECL_NIL
;
p
->
pack
.
local_nicknames
=
ECL_NIL
;
p
->
pack
.
shadowings
=
ECL_NIL
;
p
->
pack
.
uses
=
ECL_NIL
;
p
->
pack
.
usedby
=
ECL_NIL
;
...
...
@@ -184,8 +186,21 @@ process_package_list(cl_object packages)
return
packages
;
}
static
cl_object
process_local_nicknames_list
(
cl_object
local_nicknames
)
{
cl_object
l
;
local_nicknames
=
cl_copy_list
(
local_nicknames
);
for
(
l
=
local_nicknames
;
l
!=
ECL_NIL
;
l
=
ECL_CONS_CDR
(
l
))
{
ECL_RPLACA
(
l
,
si_coerce_to_package
(
ECL_CONS_CAR
(
l
)));
ECL_RPLACD
(
l
,
si_coerce_to_package
(
ECL_CONS_CDR
(
l
)));
}
return
local_nicknames
;
}
cl_object
ecl_make_package
(
cl_object
name
,
cl_object
nicknames
,
cl_object
use_list
)
ecl_make_package
(
cl_object
name
,
cl_object
nicknames
,
cl_object
use_list
,
cl_object
local_nicknames
)
{
const
cl_env_ptr
env
=
ecl_process_env
();
cl_object
x
,
other
=
ECL_NIL
;
...
...
@@ -195,6 +210,7 @@ ecl_make_package(cl_object name, cl_object nicknames, cl_object use_list)
name
=
cl_string
(
name
);
nicknames
=
process_nicknames
(
nicknames
);
use_list
=
process_package_list
(
use_list
);
local_nicknames
=
process_local_nicknames_list
(
local_nicknames
);
ECL_WITH_GLOBAL_ENV_WRLOCK_BEGIN
(
env
)
{
/* Find a similarly named package in the list of
...
...
@@ -223,6 +239,7 @@ ecl_make_package(cl_object name, cl_object nicknames, cl_object use_list)
x
->
pack
.
uses
=
CONS
(
y
,
x
->
pack
.
uses
);
y
->
pack
.
usedby
=
CONS
(
x
,
y
->
pack
.
usedby
);
}
end_loop_for_in
;
x
->
pack
.
local_nicknames
=
local_nicknames
;
/* Finally, add it to the list of packages */
cl_core
.
packages
=
CONS
(
x
,
cl_core
.
packages
);
OUTPUT
:
...
...
@@ -850,10 +867,13 @@ ecl_unuse_package(cl_object x, cl_object p)
}
ECL_WITH_GLOBAL_ENV_WRLOCK_END
;
}
@
(
defun
make_package
(
pack_name
&
key
nicknames
(
use
CONS
(
cl_core
.
lisp_package
,
ECL_NIL
)))
@
(
defun
make_package
(
pack_name
&
key
nicknames
(
use
CONS
(
cl_core
.
lisp_package
,
ECL_NIL
))
local_nicknames
)
@
/* INV: ecl_make_package() performs type checking */
@
(
return
ecl_make_package
(
pack_name
,
nicknames
,
use
));
@
(
return
ecl_make_package
(
pack_name
,
nicknames
,
use
,
local_nicknames
));
@
)
cl_object
...
...
src/c/symbols_list.h
View file @
9c2aef55
...
...
@@ -1388,6 +1388,7 @@ cl_symbols[] = {
{
KEY_
"LINK"
,
KEYWORD
,
NULL
,
-
1
,
OBJNULL
},
{
KEY_
"LIST-ALL"
,
KEYWORD
,
NULL
,
-
1
,
OBJNULL
},
{
KEY_
"LOCAL"
,
KEYWORD
,
NULL
,
-
1
,
OBJNULL
},
{
KEY_
"LOCAL-NICKNAMES"
,
KEYWORD
,
NULL
,
-
1
,
OBJNULL
},
{
KEY_
"LOCKABLE"
,
KEYWORD
,
NULL
,
-
1
,
OBJNULL
},
{
KEY_
"LOAD-TOPLEVEL"
,
KEYWORD
,
NULL
,
-
1
,
OBJNULL
},
{
KEY_
"MASK"
,
KEYWORD
,
NULL
,
-
1
,
OBJNULL
},
...
...
src/c/symbols_list2.h
View file @
9c2aef55
...
...
@@ -1388,6 +1388,7 @@ cl_symbols[] = {
{
KEY_
"LINK"
,
NULL
},
{
KEY_
"LIST-ALL"
,
NULL
},
{
KEY_
"LOCAL"
,
NULL
},
{
KEY_
"LOCAL-NICKNAMES"
,
NULL
},
{
KEY_
"LOCKABLE"
,
NULL
},
{
KEY_
"LOAD-TOPLEVEL"
,
NULL
},
{
KEY_
"MASK"
,
NULL
},
...
...
src/h/external.h
View file @
9c2aef55
...
...
@@ -1300,7 +1300,7 @@ extern ECL_API cl_object cl_shadow _ECL_ARGS((cl_narg narg, cl_object symbols, .
extern
ECL_API
cl_object
cl_use_package
_ECL_ARGS
((
cl_narg
narg
,
cl_object
pack
,
...));
extern
ECL_API
cl_object
cl_unuse_package
_ECL_ARGS
((
cl_narg
narg
,
cl_object
pack
,
...));
extern
ECL_API
cl_object
ecl_make_package
(
cl_object
n
,
cl_object
ns
,
cl_object
ul
);
extern
ECL_API
cl_object
ecl_make_package
(
cl_object
n
,
cl_object
ns
,
cl_object
ul
,
cl_object
lns
);
extern
ECL_API
cl_object
ecl_rename_package
(
cl_object
x
,
cl_object
n
,
cl_object
ns
);
extern
ECL_API
cl_object
ecl_find_package_nolock
(
cl_object
n
);
extern
ECL_API
cl_object
ecl_find_package
(
const
char
*
p
);
...
...
src/h/object.h
View file @
9c2aef55
...
...
@@ -272,11 +272,12 @@ struct ecl_symbol {
struct
ecl_package
{
_ECL_HDR1
(
locked
);
cl_object
name
;
/* package name, a string */
cl_object
nicknames
;
/* nicknames, list of strings */
cl_object
shadowings
;
/* shadowing symbol list */
cl_object
uses
;
/* use-list of packages */
cl_object
usedby
;
/* used-by-list of packages */
cl_object
name
;
/* package name, a string */
cl_object
nicknames
;
/* nicknames, list of strings */
cl_object
local_nicknames
;
/* local nicknames, assoc list */
cl_object
shadowings
;
/* shadowing symbol list */
cl_object
uses
;
/* use-list of packages */
cl_object
usedby
;
/* used-by-list of packages */
cl_object
internal
;
/* hashtable for internal symbols */
cl_object
external
;
/* hashtable for external symbols */
};
...
...
src/lsp/defpackage.lsp
View file @
9c2aef55
...
...
@@ -204,7 +204,7 @@
(
rename-package
name
name
nicknames
))
(
when
use
(
unuse-package
(
package-use-list
(
find-package
name
))
name
)))
(
make-package
name
:use
nil
:nicknames
nicknames
))
(
make-package
name
:use
nil
:nicknames
nicknames
:local-nicknames
local-nicknames
))
(
let
((
*package*
(
find-package
name
)))
(
when
documentation
(
setf
(
documentation
*package*
t
)
documentation
))
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment