1 /* identifier.c -*- mode:c; coding:utf-8; -*-
2 *
3 * Copyright (c) 2010-2021 Takashi Kato <ktakashi@ymail.com>
4 *
5 * Redistribution and use in source and binary forms, with or without
6 * modification, are permitted provided that the following conditions
7 * are met:
8 *
9 * 1. Redistributions of source code must retain the above copyright
10 * notice, this list of conditions and the following disclaimer.
11 *
12 * 2. Redistributions in binary form must reproduce the above copyright
13 * notice, this list of conditions and the following disclaimer in the
14 * documentation and/or other materials provided with the distribution.
15 *
16 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
17 * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
18 * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
19 * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
20 * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
21 * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
22 * TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
23 * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
24 * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
25 * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
26 * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
27 *
28 * $Id: $
29 */
30 #define LIBSAGITTARIUS_BODY
31 #include "sagittarius/private/identifier.h"
32 #include "sagittarius/private/symbol.h"
33 #include "sagittarius/private/library.h"
34 #include "sagittarius/private/pair.h"
35 #include "sagittarius/private/vector.h"
36 #include "sagittarius/private/hashtable.h"
37 #include "sagittarius/private/writer.h"
38 #include "sagittarius/private/port.h"
39 #include "sagittarius/private/reader.h"
40 #include "sagittarius/private/vm.h"
41
id_print(SgObject obj,SgPort * port,SgWriteContext * ctx)42 static void id_print(SgObject obj, SgPort *port, SgWriteContext *ctx)
43 {
44 SgIdentifier *id = SG_IDENTIFIER(obj);
45 Sg_Putuz(port, UC("#<identifier "));
46 Sg_Write(id->name, port, ctx->mode);
47 Sg_Putc(port, '#');
48 if (SG_LIBRARYP(id->library)) {
49 Sg_Write(id->library->name, port, SG_WRITE_DISPLAY);
50 }
51 #if 1
52 if (SG_WRITE_MODE(ctx) == SG_WRITE_WRITE ||
53 SG_WRITE_MODE(ctx) == SG_WRITE_SHARED) {
54 char buf[50];
55 Sg_Putc(port, ' ');
56 Sg_Write(SG_IDENTIFIER_IDENTITY(id), port, SG_WRITE_WRITE);
57 snprintf(buf, sizeof(buf), " (%p):%d", id, SG_IDENTIFIER_PENDING(id));
58 Sg_Putz(port, buf);
59 }
60 /* Sg_Write(id->envs, port, SG_WRITE_SHARED); */
61 #endif
62 Sg_Putc(port, '>');
63 }
64
65 SG_DEFINE_BUILTIN_CLASS_SIMPLE(Sg_IdentifierClass, id_print);
66
Sg_MakeRawIdentifier(SgObject name,SgObject envs,SgObject identity,SgLibrary * library,int pendingP)67 SgObject Sg_MakeRawIdentifier(SgObject name, SgObject envs, SgObject identity,
68 SgLibrary *library, int pendingP)
69 {
70 SgIdentifier *id = SG_NEW(SgIdentifier);
71 SG_SET_CLASS(id, SG_CLASS_IDENTIFIER);
72 SG_INIT_IDENTIFIER(id, name, envs, identity, library, pendingP);
73 return SG_OBJ(id);
74 }
75
76 /*
77 this is used from builtin libraries and the envs must be '()
78 */
Sg_MakeGlobalIdentifier(SgObject name,SgLibrary * library)79 SgObject Sg_MakeGlobalIdentifier(SgObject name, SgLibrary *library)
80 {
81 return Sg_MakeRawIdentifier(name, SG_NIL, SG_FALSE, library, FALSE);
82 }
83
Sg__InitIdentifier()84 void Sg__InitIdentifier()
85 {
86 /* For future we might want to make identifier <object> to use slot-ref
87 but for now.*/
88 SgLibrary *clib = Sg_FindLibrary(SG_INTERN("(sagittarius clos)"), TRUE);
89 Sg_InitStaticClass(SG_CLASS_IDENTIFIER, UC("<identifier>"), clib, NULL, 0);
90 }
91 /*
92 end of file
93 Local Variables:
94 coding: utf-8-unix
95 End:
96 */
97