← Back to branch summary

~ubuntu-branches/ubuntu/intrepid/ecl/intrepid

« back to all changes in this revision

Viewing changes to src/c/package.d

  • Committer: Bazaar Package Importer
  • Author(s): Peter Van Eynde
  • Date: 2007-04-09 11:51:51 UTC
  • mfrom: (1.1.3 upstream)
  • Revision ID: james.westby@ubuntu.com-20070409115151-ql8cr0kalzx1jmla
Tags: 0.9i-20070324-2
Upload to unstable. 

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/c/package.d
66
66
{
67
67
        /* INV: l is a proper list */
68
68
        for (;  CONSP(l);  l = CDR(l))
69
 
                if (string_eq(x, CAR(l)))
 
69
                if (ecl_string_eq(x, CAR(l)))
70
70
                        return(TRUE);
71
71
        return(FALSE);
72
72
}
73
73
 
74
74
/*
75
 
        Make_package(n, ns, ul) makes a package with name n,
 
75
        ecl_make_package(n, ns, ul) makes a package with name n,
76
76
        which must be a string or a symbol,
77
77
        and nicknames ns, which must be a list of strings or symbols,
78
78
        and uses packages in list ul, which must be a list of packages
88
88
        h->hash.lockable = 0;
89
89
        h->hash.test = htt_pack;
90
90
        h->hash.size = hsize;
91
 
        h->hash.rehash_size = make_shortfloat(1.5f);
92
 
        h->hash.threshold = make_shortfloat(0.75f);
 
91
        h->hash.rehash_size = ecl_make_singlefloat(1.5f);
 
92
        h->hash.threshold = ecl_make_singlefloat(0.75f);
93
93
        h->hash.factor = 0.7;
94
94
        h->hash.entries = 0;
95
95
        h->hash.data = NULL; /* for GC sake */
98
98
}
99
99
 
100
100
cl_object
101
 
make_package(cl_object name, cl_object nicknames, cl_object use_list)
 
101
ecl_make_package(cl_object name, cl_object nicknames, cl_object use_list)
102
102
{
103
103
        cl_object x, y, other;
104
104
 
113
113
        if (cl_core.packages_to_be_created != OBJNULL) {
114
114
                cl_object *p = &cl_core.packages_to_be_created;
115
115
                for (x = *p; x != Cnil; ) {
116
 
                        if (equal(CAAR(x), name)) {
 
116
                        cl_object other_name = CAAR(x);
 
117
                        if (ecl_equal(other_name, name) ||
 
118
                            funcall(5, @'member', other_name, nicknames,
 
119
                                    @':test', @'string=') != Cnil)
 
120
                        {
117
121
                                *p = CDR(x);
118
122
                                x = CDAR(x);
119
123
                                goto INTERN;
120
124
                        }
121
 
                        /* FIXME! We should also check the nicknames */
122
125
                        p = &CDR(x);
123
126
                        x = *p;
124
127
                }
155
158
        x->pack.uses = Cnil;
156
159
        x->pack.usedby = Cnil;
157
160
        x->pack.locked = FALSE;
158
 
        for (;  !endp(nicknames);  nicknames = CDR(nicknames)) {
 
161
        for (;  !ecl_endp(nicknames);  nicknames = CDR(nicknames)) {
159
162
                cl_object nick = cl_string(CAR(nicknames));
160
163
                if ((other = ecl_find_package_nolock(nick)) != Cnil) {
161
164
                        name = nick;
163
166
                }
164
167
                x->pack.nicknames = CONS(nick, x->pack.nicknames);
165
168
        }
166
 
        for (;  !endp(use_list);  use_list = CDR(use_list)) {
 
169
        for (;  !ecl_endp(use_list);  use_list = CDR(use_list)) {
167
170
                y = si_coerce_to_package(CAR(use_list));
168
171
                x->pack.uses = CONS(y, x->pack.uses);
169
172
                y->pack.usedby = CONS(x, y->pack.usedby);
176
179
}
177
180
 
178
181
cl_object
179
 
rename_package(cl_object x, cl_object name, cl_object nicknames)
 
182
ecl_rename_package(cl_object x, cl_object name, cl_object nicknames)
180
183
{
181
184
        cl_object y;
182
185
 
197
200
        x->pack.name = name;
198
201
        x->pack.nicknames = Cnil;
199
202
        assert_type_proper_list(nicknames);
200
 
        for (;  !endp(nicknames);  nicknames = CDR(nicknames)) {
 
203
        for (;  !ecl_endp(nicknames);  nicknames = CDR(nicknames)) {
201
204
                cl_object nick = CAR(nicknames);
202
205
                y = ecl_find_package_nolock(nick);
203
206
                if (x == y)
234
237
        /* INV: cl_core.packages is a proper list */
235
238
        for (l = cl_core.packages; CONSP(l); l = CDR(l)) {
236
239
                p = CAR(l);
237
 
                if (string_eq(name, p->pack.name))
 
240
                if (ecl_string_eq(name, p->pack.name))
238
241
                        return p;
239
242
                if (member_string_eq(name, p->pack.nicknames))
240
243
                        return p;
241
244
        }
 
245
#ifdef ECL_RELATIVE_PACKAGE_NAMES
 
246
        /* Note that this function may actually be called _before_ symbols are set up
 
247
         * and bound! */
 
248
        if (ecl_booted && SYM_VAL(@'si::*relative-package-names*') != Cnil) {
 
249
                return si_find_relative_package(1, name);
 
250
        }
 
251
#endif
242
252
        return Cnil;
243
253
}
244
254
 
255
265
}
256
266
 
257
267
cl_object
258
 
current_package(void)
 
268
ecl_current_package(void)
259
269
{
260
270
        cl_object x;
261
271
 
262
 
        x = symbol_value(@'*package*');
 
272
        x = ecl_symbol_value(@'*package*');
263
273
        if (type_of(x) != t_package) {
264
274
                ECL_SETQ(@'*package*', cl_core.user_package);
265
275
                FEerror("The value of *PACKAGE*, ~S, was not a package",
269
279
}
270
280
 
271
281
/*
272
 
        Intern(st, p) interns string st in package p.
 
282
        Ecl_Intern(st, p) interns string st in package p.
273
283
*/
274
284
cl_object
275
 
_intern(const char *s, cl_object p)
 
285
_ecl_intern(const char *s, cl_object p)
276
286
{
277
287
        int intern_flag;
278
288
        cl_object str = make_constant_base_string(s);
279
 
        return intern(str, p, &intern_flag);
 
289
        return ecl_intern(str, p, &intern_flag);
280
290
}
281
291
 
282
292
cl_object
283
 
intern(cl_object name, cl_object p, int *intern_flag)
 
293
ecl_intern(cl_object name, cl_object p, int *intern_flag)
284
294
{
285
295
        cl_object s, ul;
286
296
 
 
297
        name = ecl_check_type_string(@'intern', name);
287
298
#ifdef ECL_UNICODE
288
 
        name = si_copy_to_simple_base_string(name);
289
 
#else
290
 
        assert_type_base_string(name);
 
299
        if (ecl_fits_in_base_string(name)) {
 
300
                name = si_copy_to_simple_base_string(name);
 
301
        }
291
302
#endif
292
303
        p = si_coerce_to_package(p);
293
304
 TRY_AGAIN_LABEL:
294
305
        PACKAGE_LOCK(p);
295
 
        s = gethash_safe(name, p->pack.external, OBJNULL);
 
306
        s = ecl_gethash_safe(name, p->pack.external, OBJNULL);
296
307
        if (s != OBJNULL) {
297
308
                *intern_flag = EXTERNAL;
298
309
                goto OUTPUT;
299
310
        }
300
311
        /* Keyword package has no intern section nor can it be used */
301
312
        if (p == cl_core.keyword_package) goto INTERN;
302
 
        s = gethash_safe(name, p->pack.internal, OBJNULL);
 
313
        s = ecl_gethash_safe(name, p->pack.internal, OBJNULL);
303
314
        if (s != OBJNULL) {
304
315
                *intern_flag = INTERNAL;
305
316
                goto OUTPUT;
306
317
        }
307
318
        for (ul=p->pack.uses; CONSP(ul); ul = CDR(ul)) {
308
 
                s = gethash_safe(name, CAR(ul)->pack.external, OBJNULL);
 
319
                s = ecl_gethash_safe(name, CAR(ul)->pack.external, OBJNULL);
309
320
                if (s != OBJNULL) {
310
321
                        *intern_flag = INHERITED;
311
322
                        goto OUTPUT;
318
329
                                "Ignore lock and proceed", p, 2, name, p);
319
330
                goto TRY_AGAIN_LABEL;
320
331
        }
321
 
        s = make_symbol(name);
 
332
        s = cl_make_symbol(name);
322
333
        s->symbol.hpack = p;
323
334
        *intern_flag = 0;
324
335
        if (p == cl_core.keyword_package) {
325
336
                s->symbol.stype = stp_constant;
326
337
                ECL_SET(s, s);
327
 
                sethash(name, p->pack.external, s);
 
338
                ecl_sethash(name, p->pack.external, s);
328
339
        } else {
329
 
                sethash(name, p->pack.internal, s);
 
340
                ecl_sethash(name, p->pack.internal, s);
330
341
        }
331
342
 OUTPUT:
332
343
        PACKAGE_UNLOCK(p);
342
353
{
343
354
        cl_object s, ul;
344
355
 
345
 
        assert_type_base_string(name);
346
 
        s = gethash_safe(name, p->pack.external, OBJNULL);
 
356
        name = ecl_check_type_string(@'find-symbol', name);
 
357
#ifdef ECL_UNICODE
 
358
        if (ecl_fits_in_base_string(name)) {
 
359
                name = si_copy_to_simple_base_string(name);
 
360
        }
 
361
#endif
 
362
        s = ecl_gethash_safe(name, p->pack.external, OBJNULL);
347
363
        if (s != OBJNULL) {
348
364
                *intern_flag = EXTERNAL;
349
365
                goto OUTPUT;
350
366
        }
351
367
        if (p == cl_core.keyword_package)
352
368
                goto NOTHING;
353
 
        s = gethash_safe(name, p->pack.internal, OBJNULL);
 
369
        s = ecl_gethash_safe(name, p->pack.internal, OBJNULL);
354
370
        if (s != OBJNULL) {
355
371
                *intern_flag = INTERNAL;
356
372
                goto OUTPUT;
357
373
        }
358
374
        for (ul=p->pack.uses; CONSP(ul); ul = CDR(ul)) {
359
 
                s = gethash_safe(name, CAR(ul)->pack.external, OBJNULL);
 
375
                s = ecl_gethash_safe(name, CAR(ul)->pack.external, OBJNULL);
360
376
                if (s != OBJNULL) {
361
377
                        *intern_flag = INHERITED;
362
378
                        goto OUTPUT;
381
397
}
382
398
 
383
399
bool
384
 
unintern(cl_object s, cl_object p)
 
400
ecl_unintern(cl_object s, cl_object p)
385
401
{
386
402
        cl_object x, y, l, hash;
387
403
        bool output = FALSE;
388
404
 
389
 
        assert_type_symbol(s);
 
405
        s = ecl_check_cl_type(@'unintern', s, t_symbol);
 
406
 
390
407
        p = si_coerce_to_package(p);
391
408
 
392
409
 TRY_AGAIN_LABEL:
393
410
        PACKAGE_LOCK(p);
394
411
        hash = p->pack.internal;
395
 
        x = gethash_safe(s->symbol.name, hash, OBJNULL);
 
412
        x = ecl_gethash_safe(s->symbol.name, hash, OBJNULL);
396
413
        if (x == s)
397
414
                goto UNINTERN;
398
415
        hash = p->pack.external;
399
 
        x = gethash_safe(s->symbol.name, hash, OBJNULL);
 
416
        x = ecl_gethash_safe(s->symbol.name, hash, OBJNULL);
400
417
        if (x != s)
401
418
                goto OUTPUT;
402
419
 UNINTERN:
406
423
                                "Ignore lock and proceed", p, 2, s, p);
407
424
                goto TRY_AGAIN_LABEL;
408
425
        }
409
 
        if (!member_eq(s, p->pack.shadowings))
 
426
        if (!ecl_member_eq(s, p->pack.shadowings))
410
427
                goto NOT_SHADOW;
411
428
        x = OBJNULL;
412
429
        for (l = p->pack.uses; CONSP(l); l = CDR(l)) {
413
 
                y = gethash_safe(s->symbol.name, CAR(l)->pack.external, OBJNULL);
 
430
                y = ecl_gethash_safe(s->symbol.name, CAR(l)->pack.external, OBJNULL);
414
431
                if (y != OBJNULL) {
415
432
                        if (x == OBJNULL)
416
433
                                x = y;
425
442
        }
426
443
        p->pack.shadowings = ecl_remove_eq(s, p->pack.shadowings);
427
444
 NOT_SHADOW:
428
 
        remhash(s->symbol.name, hash);
 
445
        ecl_remhash(s->symbol.name, hash);
429
446
        if (s->symbol.hpack == p)
430
447
                s->symbol.hpack = Cnil;
431
448
        output = TRUE;
440
457
        cl_object x, l, hash = OBJNULL;
441
458
        int intern_flag;
442
459
 
443
 
        assert_type_symbol(s);
 
460
        s = ecl_check_cl_type(@'export', s, t_symbol);
444
461
        p = si_coerce_to_package(p);
445
462
 
446
463
        if (p->pack.locked)
467
484
        for (l = p->pack.usedby; CONSP(l); l = CDR(l)) {
468
485
                x = ecl_find_symbol_nolock(s->symbol.name, CAR(l), &intern_flag);
469
486
                if (intern_flag && s != x &&
470
 
                    !member_eq(x, CAR(l)->pack.shadowings)) {
 
487
                    !ecl_member_eq(x, CAR(l)->pack.shadowings)) {
471
488
                        PACKAGE_UNLOCK(p);
472
489
                        FEpackage_error("Cannot export the symbol ~S~%"
473
490
                                        "from ~S,~%"
476
493
                }
477
494
        }
478
495
        if (hash != OBJNULL)
479
 
                remhash(s->symbol.name, hash);
480
 
        sethash(s->symbol.name, p->pack.external, s);
 
496
                ecl_remhash(s->symbol.name, hash);
 
497
        ecl_sethash(s->symbol.name, p->pack.external, s);
481
498
 OUTPUT:
482
499
        PACKAGE_UNLOCK(p);
483
500
}
508
525
        if (Null(p->pack.name)) {
509
526
                @(return Cnil)
510
527
        }
511
 
        for (list = p->pack.uses; !endp(list); list = CDR(list))
512
 
                unuse_package(CAR(list), p);
513
 
        for (list = p->pack.usedby; !endp(list); list = CDR(list))
514
 
                unuse_package(p, CAR(list));
 
528
        for (list = p->pack.uses; !ecl_endp(list); list = CDR(list))
 
529
                ecl_unuse_package(CAR(list), p);
 
530
        for (list = p->pack.usedby; !ecl_endp(list); list = CDR(list))
 
531
                ecl_unuse_package(p, CAR(list));
515
532
        PACKAGE_LOCK(p);
516
533
        for (hash = p->pack.internal, i = 0; i < hash->hash.size; i++)
517
534
                if (hash->hash.data[i].key != OBJNULL) {
544
561
        int intern_flag;
545
562
        cl_object x;
546
563
 
547
 
        assert_type_symbol(s);
 
564
        s = ecl_check_cl_type(@'unexport', s, t_symbol);
548
565
        p = si_coerce_to_package(p);
549
566
        if (p == cl_core.keyword_package)
550
567
                FEpackage_error("Cannot unexport a symbol from the keyword package.",
564
581
                   ignored in unexport */
565
582
                (void)0;
566
583
        } else {
567
 
                remhash(s->symbol.name, p->pack.external);
568
 
                sethash(s->symbol.name, p->pack.internal, s);
 
584
                ecl_remhash(s->symbol.name, p->pack.external);
 
585
                ecl_sethash(s->symbol.name, p->pack.internal, s);
569
586
        }
570
587
        PACKAGE_UNLOCK(p);
571
588
}
576
593
        int intern_flag;
577
594
        cl_object x;
578
595
 
579
 
        assert_type_symbol(s);
 
596
        s = ecl_check_cl_type(@'import', s, t_symbol);
580
597
        p = si_coerce_to_package(p);
581
598
        if (p->pack.locked)
582
599
                CEpackage_error("Cannot import symbol ~S into locked package ~S.",
595
612
                if (intern_flag == INTERNAL || intern_flag == EXTERNAL)
596
613
                        goto OUTPUT;
597
614
        }
598
 
        sethash(s->symbol.name, p->pack.internal, s);
 
615
        ecl_sethash(s->symbol.name, p->pack.internal, s);
599
616
        if (Null(s->symbol.hpack))
600
617
                s->symbol.hpack = p;
601
618
 OUTPUT:
603
620
}
604
621
 
605
622
void
606
 
shadowing_import(cl_object s, cl_object p)
 
623
ecl_shadowing_import(cl_object s, cl_object p)
607
624
{
608
625
        int intern_flag;
609
626
        cl_object x;
610
627
 
611
 
        assert_type_symbol(s);
 
628
        s = ecl_check_cl_type(@'shadowing-import', s, t_symbol);
612
629
        p = si_coerce_to_package(p);
613
630
        if (p->pack.locked)
614
631
                CEpackage_error("Cannot shadowing-import symbol ~S into locked package ~S.",
618
635
        x = ecl_find_symbol_nolock(s->symbol.name, p, &intern_flag);
619
636
        if (intern_flag && intern_flag != INHERITED) {
620
637
                if (x == s) {
621
 
                        if (!member_eq(x, p->pack.shadowings))
 
638
                        if (!ecl_member_eq(x, p->pack.shadowings))
622
639
                                p->pack.shadowings
623
640
                                = CONS(x, p->pack.shadowings);
624
641
                        goto OUTPUT;
625
642
                }
626
 
                if(member_eq(x, p->pack.shadowings))
 
643
                if(ecl_member_eq(x, p->pack.shadowings))
627
644
                        p->pack.shadowings = ecl_remove_eq(x, p->pack.shadowings);
628
645
                if (intern_flag == INTERNAL)
629
 
                        remhash(x->symbol.name, p->pack.internal);
 
646
                        ecl_remhash(x->symbol.name, p->pack.internal);
630
647
                else
631
 
                        remhash(x->symbol.name, p->pack.external);
 
648
                        ecl_remhash(x->symbol.name, p->pack.external);
632
649
                if (x->symbol.hpack == p)
633
650
                        x->symbol.hpack = Cnil;
634
651
        }
635
652
        p->pack.shadowings = CONS(s, p->pack.shadowings);
636
 
        sethash(s->symbol.name, p->pack.internal, s);
 
653
        ecl_sethash(s->symbol.name, p->pack.internal, s);
637
654
 OUTPUT:
638
655
        PACKAGE_UNLOCK(p);
639
656
}
640
657
 
641
658
void
642
 
shadow(cl_object s, cl_object p)
 
659
ecl_shadow(cl_object s, cl_object p)
643
660
{
644
661
        int intern_flag;
645
662
        cl_object x;
653
670
        PACKAGE_LOCK(p);
654
671
        x = ecl_find_symbol_nolock(s, p, &intern_flag);
655
672
        if (intern_flag != INTERNAL && intern_flag != EXTERNAL) {
656
 
                x = make_symbol(s);
657
 
                sethash(x->symbol.name, p->pack.internal, x);
 
673
                x = cl_make_symbol(s);
 
674
                ecl_sethash(x->symbol.name, p->pack.internal, x);
658
675
                x->symbol.hpack = p;
659
676
        }
660
677
        p->pack.shadowings = CONS(x, p->pack.shadowings);
662
679
}
663
680
 
664
681
void
665
 
use_package(cl_object x, cl_object p)
 
682
ecl_use_package(cl_object x, cl_object p)
666
683
{
667
684
        struct ecl_hashtable_entry *hash_entries;
668
685
        cl_index i, hash_length;
680
697
                FEpackage_error("Cannot use in keyword package.", cl_core.keyword_package, 0);
681
698
        if (p == x)
682
699
                return;
683
 
        if (member_eq(x, p->pack.uses))
 
700
        if (ecl_member_eq(x, p->pack.uses))
684
701
                return;
685
702
 
686
703
        PACKAGE_LOCK(x);
692
709
                        cl_object here = hash_entries[i].value;
693
710
                        cl_object there = ecl_find_symbol_nolock(here->symbol.name, p, &intern_flag);
694
711
                        if (intern_flag && here != there
695
 
                            && ! member_eq(there, p->pack.shadowings)) {
 
712
                            && ! ecl_member_eq(there, p->pack.shadowings)) {
696
713
                                PACKAGE_UNLOCK(x);
697
714
                                PACKAGE_UNLOCK(p);
698
715
                                FEpackage_error("Cannot use ~S~%"
708
725
}
709
726
 
710
727
void
711
 
unuse_package(cl_object x, cl_object p)
 
728
ecl_unuse_package(cl_object x, cl_object p)
712
729
{
713
730
        x = si_coerce_to_package(x);
714
731
        p = si_coerce_to_package(p);
726
743
 
727
744
@(defun make_package (pack_name &key nicknames (use CONS(cl_core.lisp_package, Cnil)))
728
745
@
729
 
        /* INV: make_package() performs type checking */
730
 
        @(return make_package(pack_name, nicknames, use))
 
746
        /* INV: ecl_make_package() performs type checking */
 
747
        @(return ecl_make_package(pack_name, nicknames, use))
731
748
@)
732
749
 
733
750
cl_object
761
778
 
762
779
@(defun rename_package (pack new_name &o new_nicknames)
763
780
@
764
 
        /* INV: rename_package() type checks and coerces pack to package */
765
 
        @(return rename_package(pack, new_name, new_nicknames))
 
781
        /* INV: ecl_rename_package() type checks and coerces pack to package */
 
782
        @(return ecl_rename_package(pack, new_name, new_nicknames))
766
783
@)
767
784
 
768
785
cl_object
797
814
        return cl_copy_list(cl_core.packages);
798
815
}
799
816
 
800
 
@(defun intern (strng &optional (p current_package()) &aux sym)
 
817
@(defun intern (strng &optional (p ecl_current_package()) &aux sym)
801
818
        int intern_flag;
802
819
@
803
 
        sym = intern(strng, p, &intern_flag);
 
820
        sym = ecl_intern(strng, p, &intern_flag);
804
821
        if (intern_flag == INTERNAL)
805
822
                @(return sym @':internal')
806
823
        if (intern_flag == EXTERNAL)
810
827
        @(return sym Cnil)
811
828
@)
812
829
 
813
 
@(defun find_symbol (strng &optional (p current_package()))
 
830
@(defun find_symbol (strng &optional (p ecl_current_package()))
814
831
        cl_object x;
815
832
        int intern_flag;
816
833
@
824
841
        @(return Cnil Cnil)
825
842
@)
826
843
 
827
 
@(defun unintern (symbl &optional (p current_package()))
 
844
@(defun unintern (symbl &optional (p ecl_current_package()))
828
845
@
829
 
        @(return (unintern(symbl, p) ? Ct : Cnil))
 
846
        @(return (ecl_unintern(symbl, p) ? Ct : Cnil))
830
847
@)
831
848
 
832
 
@(defun export (symbols &o (pack current_package()))
 
849
@(defun export (symbols &o (pack ecl_current_package()))
833
850
        cl_object l;
834
851
@
835
852
BEGIN:
842
859
 
843
860
        case t_cons:
844
861
                pack = si_coerce_to_package(pack);
845
 
                for (l = symbols;  !endp(l);  l = CDR(l))
 
862
                for (l = symbols;  !ecl_endp(l);  l = CDR(l))
846
863
                        cl_export2(CAR(l), pack);
847
864
                break;
848
865
 
849
866
        default:
850
 
                assert_type_symbol(symbols);
 
867
                symbols = ecl_type_error(@'export',"argument",symbols,
 
868
                                         cl_list(3,@'or',@'symbol',@'list'));
851
869
                goto BEGIN;
852
870
        }
853
871
        @(return Ct)
854
872
@)
855
873
 
856
 
@(defun unexport (symbols &o (pack current_package()))
 
874
@(defun unexport (symbols &o (pack ecl_current_package()))
857
875
        cl_object l;
858
876
@
859
877
BEGIN:
866
884
 
867
885
        case t_cons:
868
886
                pack = si_coerce_to_package(pack);
869
 
                for (l = symbols;  !endp(l);  l = CDR(l))
 
887
                for (l = symbols;  !ecl_endp(l);  l = CDR(l))
870
888
                        cl_unexport2(CAR(l), pack);
871
889
                break;
872
890
 
873
891
        default:
874
 
                assert_type_symbol(symbols);
 
892
                symbols = ecl_type_error(@'unexport',"argument",symbols,
 
893
                                         cl_list(3,@'or',@'symbol',@'list'));
875
894
                goto BEGIN;
876
895
        }
877
896
        @(return Ct)
878
897
@)
879
898
 
880
 
@(defun import (symbols &o (pack current_package()))
 
899
@(defun import (symbols &o (pack ecl_current_package()))
881
900
        cl_object l;
882
901
@
883
902
BEGIN:
890
909
 
891
910
        case t_cons:
892
911
                pack = si_coerce_to_package(pack);
893
 
                for (l = symbols;  !endp(l);  l = CDR(l))
 
912
                for (l = symbols;  !ecl_endp(l);  l = CDR(l))
894
913
                        cl_import2(CAR(l), pack);
895
914
                break;
896
915
 
897
916
        default:
898
 
                assert_type_symbol(symbols);
 
917
                symbols = ecl_type_error(@'import',"argument",symbols,
 
918
                                         cl_list(3,@'or',@'symbol',@'list'));
899
919
                goto BEGIN;
900
920
        }
901
921
        @(return Ct)
902
922
@)
903
923
 
904
 
@(defun shadowing_import (symbols &o (pack current_package()))
 
924
@(defun shadowing_import (symbols &o (pack ecl_current_package()))
905
925
        cl_object l;
906
926
@
907
927
BEGIN:
909
929
        case t_symbol:
910
930
                if (Null(symbols))
911
931
                        break;
912
 
                shadowing_import(symbols, pack);
 
932
                ecl_shadowing_import(symbols, pack);
913
933
                break;
914
934
 
915
935
        case t_cons:
916
936
                pack = si_coerce_to_package(pack);
917
 
                for (l = symbols;  !endp(l);  l = CDR(l))
918
 
                        shadowing_import(CAR(l), pack);
 
937
                for (l = symbols;  !ecl_endp(l);  l = CDR(l))
 
938
                        ecl_shadowing_import(CAR(l), pack);
919
939
                break;
920
940
 
921
941
        default:
922
 
                assert_type_symbol(symbols);
 
942
                symbols = ecl_type_error(@'shadowing-import',"argument",symbols,
 
943
                                         cl_list(3,@'or',@'symbol',@'list'));
923
944
                goto BEGIN;
924
945
        }
925
946
        @(return Ct)
926
947
@)
927
948
 
928
 
@(defun shadow (symbols &o (pack current_package()))
 
949
@(defun shadow (symbols &o (pack ecl_current_package()))
929
950
        cl_object l;
930
951
@
931
952
BEGIN:
932
953
        switch (type_of(symbols)) {
 
954
#ifdef ECL_UNICODE
 
955
        case t_string:
 
956
#endif
933
957
        case t_base_string:
934
958
        case t_symbol:
935
959
        case t_character:
936
960
                /* Arguments to SHADOW may be: string designators ... */
937
961
                if (Null(symbols))
938
962
                        break;
939
 
                shadow(symbols, pack);
 
963
                ecl_shadow(symbols, pack);
940
964
                break;
941
965
        case t_cons:
942
966
                /* ... or lists of string designators */
943
967
                pack = si_coerce_to_package(pack);
944
 
                for (l = symbols;  !endp(l);  l = CDR(l))
945
 
                        shadow(CAR(l), pack);
 
968
                for (l = symbols;  !ecl_endp(l);  l = CDR(l))
 
969
                        ecl_shadow(CAR(l), pack);
946
970
                break;
947
971
        default:
948
 
                assert_type_base_string(symbols);
 
972
                symbols = ecl_type_error(@'shadow',"",symbols,
 
973
                                         cl_list(3,@'or',@'symbol',@'list'));
949
974
                goto BEGIN;
950
975
        }
951
976
        @(return Ct)
952
977
@)
953
978
 
954
 
@(defun use_package (pack &o (pa current_package()))
 
979
@(defun use_package (pack &o (pa ecl_current_package()))
955
980
        cl_object l;
956
981
@
957
982
BEGIN:
962
987
        case t_character:
963
988
        case t_base_string:
964
989
        case t_package:
965
 
                use_package(pack, pa);
 
990
                ecl_use_package(pack, pa);
966
991
                break;
967
992
 
968
993
        case t_cons:
969
994
                pa = si_coerce_to_package(pa);
970
 
                for (l = pack;  !endp(l);  l = CDR(l))
971
 
                        use_package(CAR(l), pa);
 
995
                for (l = pack;  !ecl_endp(l);  l = CDR(l))
 
996
                        ecl_use_package(CAR(l), pa);
972
997
                break;
973
998
 
974
999
        default:
978
1003
        @(return Ct)
979
1004
@)
980
1005
 
981
 
@(defun unuse_package (pack &o (pa current_package()))
 
1006
@(defun unuse_package (pack &o (pa ecl_current_package()))
982
1007
        cl_object l;
983
1008
@
984
1009
BEGIN:
989
1014
        case t_character:
990
1015
        case t_base_string:
991
1016
        case t_package:
992
 
                unuse_package(pack, pa);
 
1017
                ecl_unuse_package(pack, pa);
993
1018
                break;
994
1019
 
995
1020
        case t_cons:
996
1021
                pa = si_coerce_to_package(pa);
997
 
                for (l = pack;  !endp(l);  l = CDR(l))
998
 
                        unuse_package(CAR(l), pa);
 
1022
                for (l = pack;  !ecl_endp(l);  l = CDR(l))
 
1023
                        ecl_unuse_package(CAR(l), pa);
999
1024
                break;
1000
1025
 
1001
1026
        default: