1 /* gloc.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/gloc.h"
32 #include "sagittarius/private/port.h"
33 #include "sagittarius/private/writer.h"
34
gloc_print(SgObject obj,SgPort * port,SgWriteContext * ctx)35 static void gloc_print(SgObject obj, SgPort *port, SgWriteContext *ctx)
36 {
37 SgGloc *g = SG_GLOC(obj);
38 Sg_Putuz(port, UC("#<gloc "));
39 Sg_Write(g->name, port, ctx->mode);
40 Sg_Putc(port, ' ');
41 Sg_Write(g->library, port, ctx->mode);
42 Sg_Putc(port, '>');
43 }
44
45 SG_DEFINE_BUILTIN_CLASS_SIMPLE(Sg_GlocClass, gloc_print);
46
Sg_MakeGloc(SgSymbol * name,SgLibrary * library)47 SgObject Sg_MakeGloc(SgSymbol *name, SgLibrary *library)
48 {
49 SgGloc *g = SG_NEW(SgGloc);
50 SG_SET_CLASS(g, SG_CLASS_GLOC);
51 g->name = name;
52 g->library = library;
53 g->value = SG_UNBOUND;
54 g->constant = FALSE;
55 return SG_OBJ(g);
56 }
57
Sg_GlocConstP(SgGloc * g)58 int Sg_GlocConstP(SgGloc *g)
59 {
60 return g->constant;
61 }
62
63