mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-05 03:30:24 +02:00
Move source properties out to a module
* module/ice-9/source-properties.scm: New file, providing the source-properties API, as well as a replacement for `read' that always attaches source properties, regardless of the 'positions option on the port. * am/bootstrap.am (SOURCES): Add the new file. * libguile/srcprop.c: * libguile/srcprop.h: Remove. * libguile/Makefile.am (libguile_@GUILE_EFFECTIVE_VERSION@_la_SOURCES): (DOT_X_FILES): (DOT_DOC_FILES): (modinclude_HEADERS): * libguile.h: Remove srcprop.h. * libguile/deprecated.c: * libguile/deprecated.h: Add deprecation shims for srcprop.h interface. * libguile/backtrace.c: * libguile/debug.c: * libguile/eval.c: * libguile/init.c: * libguile/memoize.c: * libguile/promises.c: * libguile/read.c: * libguile/syntax.c: Remove needless srcprop.h includes. * module/ice-9/boot-9.scm: Reorder some definitions so that deprecated modules can use the (system syntax internal) module. * module/ice-9/deprecated.scm: Add shims for Scheme source-properties interface. * module/ice-9/read.scm (read): Never attach source properties. Users that want source can use read-syntax. * module/language/cps.scm: * module/language/cps/spec.scm: * module/language/ecmascript/compile-tree-il.scm: * module/language/elisp/compile-tree-il.scm: * module/language/elisp/lexer.scm: * module/language/elisp/parser.scm: * module/language/tree-il.scm: * module/language/tree-il/spec.scm: * module/language/wisp.scm: * module/system/base/lalr.scm: * test-suite/tests/elisp-reader.test: * test-suite/tests/reader.test: * test-suite/tests/srcprop.test: * test-suite/tests/srfi-105.test: * test-suite/tests/srfi-119.test: Use the (ice-9 source-properties) module to get access to source properties.
This commit is contained in:
Andy Wingo
parent
b6b6f62548
commit
e3b743dc72
34 changed files with 327 additions and 536 deletions
|
|
@ -214,7 +214,6 @@ libguile_@GUILE_EFFECTIVE_VERSION@_la_SOURCES = \
|
|||
simpos.c \
|
||||
smob.c \
|
||||
sort.c \
|
||||
srcprop.c \
|
||||
srfi-4.c \
|
||||
srfi-13.c \
|
||||
srfi-14.c \
|
||||
|
|
@ -326,7 +325,6 @@ DOT_X_FILES = \
|
|||
simpos.x \
|
||||
smob.x \
|
||||
sort.x \
|
||||
srcprop.x \
|
||||
srfi-4.x \
|
||||
srfi-13.x \
|
||||
srfi-14.x \
|
||||
|
|
@ -425,7 +423,6 @@ DOT_DOC_FILES = \
|
|||
simpos.doc \
|
||||
smob.doc \
|
||||
sort.doc \
|
||||
srcprop.doc \
|
||||
srfi-4.doc \
|
||||
srfi-13.doc \
|
||||
srfi-14.doc \
|
||||
|
|
@ -684,7 +681,6 @@ modinclude_HEADERS = \
|
|||
snarf.h \
|
||||
socket.h \
|
||||
sort.h \
|
||||
srcprop.h \
|
||||
srfi-4.h \
|
||||
srfi-13.h \
|
||||
srfi-14.h \
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
/* Printing of backtraces and error messages
|
||||
|
||||
Copyright 1996-2001,2003-2004,2006,2009-2011,2014,2018
|
||||
Copyright 1996-2001,2003-2004,2006,2009-2011,2014,2018,2025
|
||||
Free Software Foundation, Inc.
|
||||
|
||||
This file is part of Guile.
|
||||
|
|
@ -46,7 +46,6 @@
|
|||
#include "ports.h"
|
||||
#include "posix.h"
|
||||
#include "private-options.h"
|
||||
#include "srcprop.h"
|
||||
#include "stacks.h"
|
||||
#include "strings.h"
|
||||
#include "strports.h"
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
/* Debugging extensions for Guile
|
||||
|
||||
Copyright 1995-2003,2006,2008-2013,2018
|
||||
Copyright 1995-2003,2006,2008-2013,2018,2025
|
||||
Free Software Foundation, Inc.
|
||||
|
||||
This file is part of Guile.
|
||||
|
|
@ -55,7 +55,6 @@
|
|||
#include "programs.h"
|
||||
#include "read.h"
|
||||
#include "smob.h"
|
||||
#include "srcprop.h"
|
||||
#include "stackchk.h"
|
||||
#include "strports.h"
|
||||
#include "struct.h"
|
||||
|
|
|
|||
|
|
@ -28,6 +28,7 @@
|
|||
#include "gsubr.h"
|
||||
#include "modules.h"
|
||||
#include "numbers.h"
|
||||
#include "symbols.h"
|
||||
#include "threads.h"
|
||||
#include "variable.h"
|
||||
|
||||
|
|
@ -230,6 +231,80 @@ scm_set_object_property_x (SCM obj, SCM key, SCM value)
|
|||
}
|
||||
|
||||
|
||||
|
||||
|
||||
SCM_GLOBAL_SYMBOL (scm_sym_filename, "filename");
|
||||
SCM_GLOBAL_SYMBOL (scm_sym_line, "line");
|
||||
SCM_GLOBAL_SYMBOL (scm_sym_column, "column");
|
||||
|
||||
static SCM source_properties_var;
|
||||
static SCM set_source_properties_var;
|
||||
static SCM source_property_var;
|
||||
static SCM set_source_property_var;
|
||||
static SCM cons_source_var;
|
||||
|
||||
static void
|
||||
init_source_properties_vars (void)
|
||||
{
|
||||
source_properties_var =
|
||||
scm_c_public_lookup ("ice-9 source-properties", "source-properties");
|
||||
set_source_properties_var =
|
||||
scm_c_public_lookup ("ice-9 source-properties", "set-source-properties!");
|
||||
source_property_var =
|
||||
scm_c_public_lookup ("ice-9 source-properties", "source-property");
|
||||
set_source_property_var =
|
||||
scm_c_public_lookup ("ice-9 source-properties", "set-source-property!");
|
||||
cons_source_var =
|
||||
scm_c_public_lookup ("ice-9 source-properties", "cons-source");
|
||||
}
|
||||
|
||||
static void
|
||||
init_source_properties (void)
|
||||
{
|
||||
static scm_i_pthread_once_t once = SCM_I_PTHREAD_ONCE_INIT;
|
||||
scm_c_issue_deprecation_warning
|
||||
("The source properties C interface is deprecated. Invoke the Scheme "
|
||||
"procedures from (ice-9 source-properties) instead.");
|
||||
scm_i_pthread_once (&once, init_source_properties_vars);
|
||||
}
|
||||
|
||||
SCM
|
||||
scm_source_properties (SCM obj)
|
||||
{
|
||||
init_source_properties ();
|
||||
return scm_call_1 (scm_variable_ref (source_properties_var), obj);
|
||||
}
|
||||
|
||||
|
||||
SCM
|
||||
scm_set_source_properties_x (SCM obj, SCM alist)
|
||||
{
|
||||
init_source_properties ();
|
||||
return scm_call_2 (scm_variable_ref (set_source_properties_var), obj, alist);
|
||||
}
|
||||
|
||||
SCM
|
||||
scm_source_property (SCM obj, SCM key)
|
||||
{
|
||||
init_source_properties ();
|
||||
return scm_call_2 (scm_variable_ref (source_property_var), obj, key);
|
||||
}
|
||||
|
||||
SCM
|
||||
scm_set_source_property_x (SCM obj, SCM key, SCM value)
|
||||
{
|
||||
init_source_properties ();
|
||||
return scm_call_3 (scm_variable_ref (set_source_property_var), obj, key, value);
|
||||
}
|
||||
|
||||
SCM
|
||||
scm_cons_source (SCM orig, SCM x, SCM y)
|
||||
{
|
||||
init_source_properties ();
|
||||
return scm_call_3 (scm_variable_ref (cons_source_var), orig, x, y);
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
void
|
||||
|
|
|
|||
|
|
@ -46,6 +46,16 @@ SCM_DEPRECATED SCM scm_set_object_properties_x (SCM obj, SCM plist);
|
|||
SCM_DEPRECATED SCM scm_object_property (SCM obj, SCM key);
|
||||
SCM_DEPRECATED SCM scm_set_object_property_x (SCM obj, SCM key, SCM val);
|
||||
|
||||
SCM_DEPRECATED SCM scm_sym_filename;
|
||||
SCM_DEPRECATED SCM scm_sym_line;
|
||||
SCM_DEPRECATED SCM scm_sym_column;
|
||||
SCM_DEPRECATED SCM scm_supports_source_properties_p (SCM obj);
|
||||
SCM_DEPRECATED SCM scm_source_property (SCM obj, SCM key);
|
||||
SCM_DEPRECATED SCM scm_set_source_property_x (SCM obj, SCM key, SCM datum);
|
||||
SCM_DEPRECATED SCM scm_source_properties (SCM obj);
|
||||
SCM_DEPRECATED SCM scm_set_source_properties_x (SCM obj, SCM props);
|
||||
SCM_DEPRECATED SCM scm_cons_source (SCM xorig, SCM x, SCM y);
|
||||
|
||||
/* Deprecated declarations go here. */
|
||||
|
||||
void scm_i_init_deprecated (void);
|
||||
|
|
|
|||
|
|
@ -56,7 +56,6 @@
|
|||
#include "procprop.h"
|
||||
#include "programs.h"
|
||||
#include "smob.h"
|
||||
#include "srcprop.h"
|
||||
#include "stackchk.h"
|
||||
#include "strings.h"
|
||||
#include "symbols.h"
|
||||
|
|
|
|||
|
|
@ -124,7 +124,6 @@
|
|||
#include "smob.h"
|
||||
#include "socket.h"
|
||||
#include "sort.h"
|
||||
#include "srcprop.h"
|
||||
#include "srfi-13.h"
|
||||
#include "srfi-14.h"
|
||||
#include "srfi-4.h"
|
||||
|
|
@ -431,7 +430,6 @@ scm_i_init_guile (struct gc_stack_addr base)
|
|||
scm_init_socket ();
|
||||
#endif
|
||||
scm_init_sort ();
|
||||
scm_init_srcprop (); /* requires smob_prehistory */
|
||||
scm_init_stackchk ();
|
||||
|
||||
scm_init_generalized_vectors ();
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
/* Copyright 1995-2015,2018
|
||||
/* Copyright 1995-2015,2018,2025
|
||||
Free Software Foundation, Inc.
|
||||
|
||||
This file is part of Guile.
|
||||
|
|
@ -40,7 +40,6 @@
|
|||
#include "pairs.h"
|
||||
#include "ports.h"
|
||||
#include "print.h"
|
||||
#include "srcprop.h"
|
||||
#include "strings.h"
|
||||
#include "symbols.h"
|
||||
#include "threads.h"
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
/* Copyright 1995-2011,2018
|
||||
/* Copyright 1995-2011,2018,2025
|
||||
Free Software Foundation, Inc.
|
||||
|
||||
This file is part of Guile.
|
||||
|
|
@ -49,7 +49,6 @@
|
|||
#include "procs.h"
|
||||
#include "programs.h"
|
||||
#include "smob.h"
|
||||
#include "srcprop.h"
|
||||
#include "stackchk.h"
|
||||
#include "strings.h"
|
||||
#include "threads.h"
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
/* Copyright 1995-1997,1999-2001,2003-2004,2006-2012,2014-2021
|
||||
/* Copyright 1995-1997,1999-2001,2003-2004,2006-2012,2014-2021,2025
|
||||
Free Software Foundation, Inc.
|
||||
|
||||
This file is part of Guile.
|
||||
|
|
@ -54,7 +54,6 @@
|
|||
#include "ports.h"
|
||||
#include "private-options.h"
|
||||
#include "procs.h"
|
||||
#include "srcprop.h"
|
||||
#include "srfi-13.h"
|
||||
#include "srfi-4.h"
|
||||
#include "strings.h"
|
||||
|
|
|
|||
|
|
@ -1,326 +0,0 @@
|
|||
/* Copyright 1995-2002,2006,2008-2012,2018,2020
|
||||
Free Software Foundation, Inc.
|
||||
|
||||
This file is part of Guile.
|
||||
|
||||
Guile is free software: you can redistribute it and/or modify it
|
||||
under the terms of the GNU Lesser General Public License as published
|
||||
by the Free Software Foundation, either version 3 of the License, or
|
||||
(at your option) any later version.
|
||||
|
||||
Guile is distributed in the hope that it will be useful, but WITHOUT
|
||||
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
|
||||
FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public
|
||||
License for more details.
|
||||
|
||||
You should have received a copy of the GNU Lesser General Public
|
||||
License along with Guile. If not, see
|
||||
<https://www.gnu.org/licenses/>. */
|
||||
|
||||
|
||||
|
||||
|
||||
#ifdef HAVE_CONFIG_H
|
||||
# include <config.h>
|
||||
#endif
|
||||
|
||||
#include <errno.h>
|
||||
|
||||
#include "alist.h"
|
||||
#include "async.h"
|
||||
#include "debug.h"
|
||||
#include "gc.h"
|
||||
#include "gsubr.h"
|
||||
#include "hash.h"
|
||||
#include "hashtab.h"
|
||||
#include "keywords.h"
|
||||
#include "list.h"
|
||||
#include "modules.h"
|
||||
#include "numbers.h"
|
||||
#include "pairs.h"
|
||||
#include "ports.h"
|
||||
#include "private-options.h"
|
||||
#include "smob.h"
|
||||
#include "symbols.h"
|
||||
#include "weak-table.h"
|
||||
|
||||
#include "srcprop.h"
|
||||
|
||||
|
||||
|
||||
/* {Source Properties}
|
||||
*
|
||||
* Properties of source list expressions.
|
||||
* Three of these have special meaning:
|
||||
*
|
||||
* filename The name of the source file.
|
||||
* line The source code line number.
|
||||
* column The source code column number.
|
||||
*
|
||||
* Most properties above can be set by the reader.
|
||||
*
|
||||
*/
|
||||
|
||||
SCM_GLOBAL_SYMBOL (scm_sym_filename, "filename");
|
||||
SCM_GLOBAL_SYMBOL (scm_sym_line, "line");
|
||||
SCM_GLOBAL_SYMBOL (scm_sym_column, "column");
|
||||
|
||||
static SCM scm_source_whash;
|
||||
|
||||
|
||||
/*
|
||||
* Source properties are stored as double cells with the
|
||||
* following layout:
|
||||
|
||||
* car = tag | col (untagged)
|
||||
* cbr = line
|
||||
* ccr = filename
|
||||
* cdr = alist
|
||||
*/
|
||||
|
||||
static scm_t_bits tc16_srcprops;
|
||||
|
||||
#define SRCPROPSP(p) (SCM_SMOB_PREDICATE (tc16_srcprops, (p)))
|
||||
#define SRCPROPCOL(p) (scm_from_int (SCM_SMOB_FLAGS (p)))
|
||||
#define SRCPROPLINE(p) (SCM_SMOB_OBJECT_1 (p))
|
||||
#define SRCPROPFNAME(p) (SCM_SMOB_OBJECT_2 (p))
|
||||
#define SRCPROPALIST(p) (SCM_SMOB_OBJECT_3 (p))
|
||||
#define SETSRCPROPCOL(p, c) (SCM_SET_SMOB_FLAGS (p, scm_to_int (c)))
|
||||
#define SETSRCPROPLINE(p, l) (SCM_SET_SMOB_OBJECT_1 (p, l))
|
||||
#define SETSRCPROPFNAME(p, x) (SCM_SET_SMOB_OBJECT_2 (p, x))
|
||||
#define SETSRCPROPALIST(p, x) (SCM_SET_SMOB_OBJECT_3 (p, x))
|
||||
|
||||
|
||||
static SCM scm_srcprops_to_alist (SCM obj);
|
||||
|
||||
|
||||
|
||||
static int
|
||||
supports_source_props (SCM obj)
|
||||
{
|
||||
return SCM_NIMP (obj) && !scm_is_symbol (obj) && !scm_is_keyword (obj);
|
||||
}
|
||||
|
||||
|
||||
static int
|
||||
srcprops_print (SCM obj, SCM port, scm_print_state *pstate)
|
||||
{
|
||||
int writingp = SCM_WRITINGP (pstate);
|
||||
scm_puts ("#<srcprops ", port);
|
||||
SCM_SET_WRITINGP (pstate, 1);
|
||||
scm_iprin1 (scm_srcprops_to_alist (obj), port, pstate);
|
||||
SCM_SET_WRITINGP (pstate, writingp);
|
||||
scm_putc ('>', port);
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
SCM
|
||||
scm_i_make_srcprops (SCM line, SCM col, SCM filename, SCM alist)
|
||||
{
|
||||
SCM_RETURN_NEWSMOB3 (tc16_srcprops | (scm_to_int (col) << 16),
|
||||
SCM_UNPACK (line),
|
||||
SCM_UNPACK (filename),
|
||||
SCM_UNPACK (alist));
|
||||
}
|
||||
|
||||
static SCM
|
||||
scm_srcprops_to_alist (SCM obj)
|
||||
{
|
||||
SCM alist = SRCPROPALIST (obj);
|
||||
if (scm_is_true (SRCPROPFNAME (obj)))
|
||||
alist = scm_acons (scm_sym_filename, SRCPROPFNAME (obj), alist);
|
||||
alist = scm_acons (scm_sym_column, SRCPROPCOL (obj), alist);
|
||||
alist = scm_acons (scm_sym_line, SRCPROPLINE (obj), alist);
|
||||
return alist;
|
||||
}
|
||||
|
||||
SCM_DEFINE (scm_supports_source_properties_p, "supports-source-properties?", 1, 0, 0,
|
||||
(SCM obj),
|
||||
"Return #t if @var{obj} supports adding source properties,\n"
|
||||
"otherwise return #f.")
|
||||
#define FUNC_NAME s_scm_supports_source_properties_p
|
||||
{
|
||||
return scm_from_bool (supports_source_props (obj));
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
SCM_DEFINE (scm_source_properties, "source-properties", 1, 0, 0,
|
||||
(SCM obj),
|
||||
"Return the source property association list of @var{obj}.")
|
||||
#define FUNC_NAME s_scm_source_properties
|
||||
{
|
||||
if (SCM_IMP (obj))
|
||||
return SCM_EOL;
|
||||
else
|
||||
{
|
||||
SCM p = scm_weak_table_refq (scm_source_whash, obj, SCM_EOL);
|
||||
|
||||
if (SRCPROPSP (p))
|
||||
return scm_srcprops_to_alist (p);
|
||||
else
|
||||
/* list from set-source-properties!, or SCM_EOL for not found */
|
||||
return p;
|
||||
}
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
#define SCM_VALIDATE_NIM(pos, scm) \
|
||||
SCM_MAKE_VALIDATE_MSG (pos, scm, NIMP, "non-immediate")
|
||||
|
||||
/* Perhaps this procedure should look through an alist
|
||||
and try to make a srcprops-object...? */
|
||||
SCM_DEFINE (scm_set_source_properties_x, "set-source-properties!", 2, 0, 0,
|
||||
(SCM obj, SCM alist),
|
||||
"Install the association list @var{alist} as the source property\n"
|
||||
"list for @var{obj}.")
|
||||
#define FUNC_NAME s_scm_set_source_properties_x
|
||||
{
|
||||
SCM_VALIDATE_NIM (1, obj);
|
||||
|
||||
scm_weak_table_putq_x (scm_source_whash, obj, alist);
|
||||
|
||||
return alist;
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
int
|
||||
scm_i_has_source_properties (SCM obj)
|
||||
#define FUNC_NAME "%set-source-properties"
|
||||
{
|
||||
if (SCM_IMP (obj))
|
||||
return 0;
|
||||
else
|
||||
return scm_is_true (scm_weak_table_refq (scm_source_whash, obj, SCM_BOOL_F));
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
|
||||
void
|
||||
scm_i_set_source_properties_x (SCM obj, SCM line, SCM col, SCM fname)
|
||||
#define FUNC_NAME "%set-source-properties"
|
||||
{
|
||||
SCM_VALIDATE_NIM (1, obj);
|
||||
|
||||
scm_weak_table_putq_x (scm_source_whash, obj,
|
||||
scm_i_make_srcprops (line, col, fname, SCM_EOL));
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
SCM_DEFINE (scm_source_property, "source-property", 2, 0, 0,
|
||||
(SCM obj, SCM key),
|
||||
"Return the source property specified by @var{key} from\n"
|
||||
"@var{obj}'s source property list.")
|
||||
#define FUNC_NAME s_scm_source_property
|
||||
{
|
||||
SCM p;
|
||||
|
||||
if (SCM_IMP (obj))
|
||||
return SCM_BOOL_F;
|
||||
|
||||
p = scm_weak_table_refq (scm_source_whash, obj, SCM_EOL);
|
||||
|
||||
if (!SRCPROPSP (p))
|
||||
goto alist;
|
||||
if (scm_is_eq (scm_sym_line, key))
|
||||
return SRCPROPLINE (p);
|
||||
else if (scm_is_eq (scm_sym_column, key))
|
||||
return SRCPROPCOL (p);
|
||||
else if (scm_is_eq (scm_sym_filename, key))
|
||||
return SRCPROPFNAME (p);
|
||||
else
|
||||
{
|
||||
p = SRCPROPALIST (p);
|
||||
alist:
|
||||
p = scm_assoc (key, p);
|
||||
return (scm_is_pair (p) ? SCM_CDR (p) : SCM_BOOL_F);
|
||||
}
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
static scm_i_pthread_mutex_t source_mutex = SCM_I_PTHREAD_MUTEX_INITIALIZER;
|
||||
|
||||
SCM_DEFINE (scm_set_source_property_x, "set-source-property!", 3, 0, 0,
|
||||
(SCM obj, SCM key, SCM datum),
|
||||
"Set the source property of object @var{obj}, which is specified by\n"
|
||||
"@var{key} to @var{datum}. Normally, the key will be a symbol.")
|
||||
#define FUNC_NAME s_scm_set_source_property_x
|
||||
{
|
||||
SCM p;
|
||||
SCM_VALIDATE_NIM (1, obj);
|
||||
|
||||
scm_i_pthread_mutex_lock (&source_mutex);
|
||||
p = scm_weak_table_refq (scm_source_whash, obj, SCM_EOL);
|
||||
|
||||
if (scm_is_eq (scm_sym_line, key))
|
||||
{
|
||||
if (SRCPROPSP (p))
|
||||
SETSRCPROPLINE (p, datum);
|
||||
else
|
||||
scm_weak_table_putq_x (scm_source_whash, obj,
|
||||
scm_i_make_srcprops (datum, SCM_INUM0,
|
||||
SCM_BOOL_F, p));
|
||||
}
|
||||
else if (scm_is_eq (scm_sym_column, key))
|
||||
{
|
||||
if (SRCPROPSP (p))
|
||||
SETSRCPROPCOL (p, datum);
|
||||
else
|
||||
scm_weak_table_putq_x (scm_source_whash, obj,
|
||||
scm_i_make_srcprops (SCM_INUM0, datum,
|
||||
SCM_BOOL_F, p));
|
||||
}
|
||||
else if (scm_is_eq (scm_sym_filename, key))
|
||||
{
|
||||
if (SRCPROPSP (p))
|
||||
SETSRCPROPFNAME (p, datum);
|
||||
else
|
||||
scm_weak_table_putq_x (scm_source_whash, obj,
|
||||
scm_i_make_srcprops (SCM_INUM0, SCM_INUM0,
|
||||
datum, p));
|
||||
}
|
||||
else
|
||||
{
|
||||
if (SRCPROPSP (p))
|
||||
SETSRCPROPALIST (p, scm_acons (key, datum, SRCPROPALIST (p)));
|
||||
else
|
||||
scm_weak_table_putq_x (scm_source_whash, obj,
|
||||
scm_acons (key, datum, p));
|
||||
}
|
||||
scm_i_pthread_mutex_unlock (&source_mutex);
|
||||
|
||||
return SCM_UNSPECIFIED;
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
|
||||
SCM_DEFINE (scm_cons_source, "cons-source", 3, 0, 0,
|
||||
(SCM xorig, SCM x, SCM y),
|
||||
"Create and return a new pair whose car and cdr are @var{x} and @var{y}.\n"
|
||||
"Any source properties associated with @var{xorig} are also associated\n"
|
||||
"with the new pair.")
|
||||
#define FUNC_NAME s_scm_cons_source
|
||||
{
|
||||
SCM p, z;
|
||||
z = scm_cons (x, y);
|
||||
/* Copy source properties possibly associated with xorig. */
|
||||
p = scm_weak_table_refq (scm_source_whash, xorig, SCM_BOOL_F);
|
||||
if (scm_is_true (p))
|
||||
scm_weak_table_putq_x (scm_source_whash, z, p);
|
||||
return z;
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
|
||||
void
|
||||
scm_init_srcprop ()
|
||||
{
|
||||
tc16_srcprops = scm_make_smob_type ("srcprops", 0);
|
||||
scm_set_smob_print (tc16_srcprops, srcprops_print);
|
||||
|
||||
scm_source_whash = scm_c_make_weak_table (0, SCM_WEAK_TABLE_KIND_KEY);
|
||||
scm_c_define ("source-whash", scm_source_whash);
|
||||
|
||||
#include "srcprop.x"
|
||||
}
|
||||
|
||||
|
|
@ -1,53 +0,0 @@
|
|||
#ifndef SCM_SRCPROP_H
|
||||
#define SCM_SRCPROP_H
|
||||
|
||||
/* Copyright 1995-1996,2000-2001,2006,2008-2012,2018,2020
|
||||
Free Software Foundation, Inc.
|
||||
|
||||
This file is part of Guile.
|
||||
|
||||
Guile is free software: you can redistribute it and/or modify it
|
||||
under the terms of the GNU Lesser General Public License as published
|
||||
by the Free Software Foundation, either version 3 of the License, or
|
||||
(at your option) any later version.
|
||||
|
||||
Guile is distributed in the hope that it will be useful, but WITHOUT
|
||||
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
|
||||
FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public
|
||||
License for more details.
|
||||
|
||||
You should have received a copy of the GNU Lesser General Public
|
||||
License along with Guile. If not, see
|
||||
<https://www.gnu.org/licenses/>. */
|
||||
|
||||
|
||||
|
||||
#include "libguile/boolean.h"
|
||||
|
||||
|
||||
|
||||
/* {Source properties}
|
||||
*/
|
||||
|
||||
SCM_API SCM scm_sym_filename;
|
||||
SCM_API SCM scm_sym_line;
|
||||
SCM_API SCM scm_sym_column;
|
||||
|
||||
|
||||
|
||||
SCM_API SCM scm_supports_source_properties_p (SCM obj);
|
||||
SCM_API SCM scm_source_property (SCM obj, SCM key);
|
||||
SCM_API SCM scm_set_source_property_x (SCM obj, SCM key, SCM datum);
|
||||
SCM_API SCM scm_source_properties (SCM obj);
|
||||
SCM_API SCM scm_set_source_properties_x (SCM obj, SCM props);
|
||||
|
||||
SCM_INTERNAL SCM scm_i_make_srcprops (SCM line, SCM col, SCM fname, SCM alist);
|
||||
SCM_INTERNAL int scm_i_has_source_properties (SCM obj);
|
||||
SCM_INTERNAL void scm_i_set_source_properties_x (SCM obj, SCM line, SCM col,
|
||||
SCM fname);
|
||||
|
||||
SCM_API SCM scm_cons_source (SCM xorig, SCM x, SCM y);
|
||||
SCM_INTERNAL void scm_init_srcprop (void);
|
||||
|
||||
|
||||
#endif /* SCM_SRCPROP_H */
|
||||
|
|
@ -31,7 +31,6 @@
|
|||
#include "modules.h"
|
||||
#include "pairs.h"
|
||||
#include "ports.h"
|
||||
#include "srcprop.h"
|
||||
#include "threads.h"
|
||||
#include "variable.h"
|
||||
#include "vectors.h"
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue