core: Add hashq-table type.
src/hash.c: New file. src/module.c (char_hash, module_hash): Remove. * src/module.c (make_initial_module): Use hash primitives. (module_define_x): Likewise. (module_variable): Likewise. * build-aux/snarf.sh: Snarf it. * src/mes.c: Include it.
This commit is contained in:
Jan Nieuwenhuizen
parent
97a7989616
commit
235047116b
|
|
@ -28,6 +28,7 @@ if [ -n "$1" ]; then
|
|||
snarf=.mes
|
||||
fi
|
||||
trace "SNARF$snarf gc.c" ${srcdest}build-aux/mes-snarf.scm $1 src/gc.c
|
||||
trace "SNARF$snarf hash.c" ${srcdest}build-aux/mes-snarf.scm $1 src/hash.c
|
||||
trace "SNARF$snarf lib.c" ${srcdest}build-aux/mes-snarf.scm $1 src/lib.c
|
||||
trace "SNARF$snarf math.c" ${srcdest}build-aux/mes-snarf.scm $1 src/math.c
|
||||
trace "SNARF$snarf mes.c" ${srcdest}build-aux/mes-snarf.scm $1 src/mes.c
|
||||
|
|
|
|||
|
|
@ -0,0 +1,94 @@
|
|||
/* -*-comment-start: "//";comment-end:""-*-
|
||||
* GNU Mes --- Maxwell Equations of Software
|
||||
* Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
|
||||
*
|
||||
* This file is part of GNU Mes.
|
||||
*
|
||||
* GNU Mes is free software; you can redistribute it and/or modify it
|
||||
* under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 3 of the License, or (at
|
||||
* your option) any later version.
|
||||
*
|
||||
* GNU Mes 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 General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with GNU Mes. If not, see <http://www.gnu.org/licenses/>.
|
||||
*/
|
||||
|
||||
SCM make_vector__ (long k);
|
||||
SCM vector_ref_ (SCM x, long i);
|
||||
SCM vector_set_x_ (SCM x, long i, SCM e);
|
||||
|
||||
int
|
||||
char_hash (int c)
|
||||
{
|
||||
if (c >= 'a' && c <= 'z')
|
||||
return c - 'a';
|
||||
return 27;
|
||||
}
|
||||
|
||||
int
|
||||
hashq_ (SCM x, long size)
|
||||
{
|
||||
int hash = char_hash (VALUE (CAR (STRING (x)))) * 27;
|
||||
if (TYPE (CDR (STRING (x))) == TPAIR)
|
||||
hash = hash + char_hash (VALUE (CADR (STRING (x))));
|
||||
else
|
||||
hash = hash + char_hash (0);
|
||||
assert (hash <= 756);
|
||||
return hash;
|
||||
}
|
||||
|
||||
int
|
||||
hashq (SCM x, SCM size)
|
||||
{
|
||||
return hashq_ (x, VALUE (size));
|
||||
}
|
||||
|
||||
SCM
|
||||
hashq_ref (SCM table, SCM key, SCM dflt)
|
||||
{
|
||||
unsigned hash = hashq_ (key, 0);
|
||||
SCM bucket = vector_ref_ (table, hash);
|
||||
SCM x = cell_f;
|
||||
if (TYPE (dflt) == TPAIR)
|
||||
x = CAR (dflt);
|
||||
if (TYPE (bucket) == TPAIR)
|
||||
x = assq (key, bucket);
|
||||
return x;
|
||||
}
|
||||
|
||||
SCM
|
||||
hashq_set_x (SCM table, SCM key, SCM value)
|
||||
{
|
||||
unsigned hash = hashq_ (key, 0);
|
||||
SCM bucket = vector_ref_ (table, hash);
|
||||
if (TYPE (bucket) != TPAIR)
|
||||
bucket = cell_nil;
|
||||
bucket = acons (key, value, bucket);
|
||||
vector_set_x_ (table, hash, bucket);
|
||||
return value;
|
||||
}
|
||||
|
||||
SCM
|
||||
make_hash_table_ (long size)
|
||||
{
|
||||
if (!size)
|
||||
size = 30 * 27;
|
||||
return make_vector__ (size);
|
||||
}
|
||||
|
||||
SCM
|
||||
make_hash_table (SCM x)
|
||||
{
|
||||
long size = 0;
|
||||
if (TYPE (x) == TPAIR)
|
||||
{
|
||||
assert (TYPE (x) == TNUMBER);
|
||||
size = VALUE (x);
|
||||
}
|
||||
return make_hash_table_ (size);
|
||||
}
|
||||
|
|
@ -279,6 +279,7 @@ int g_function = 0;
|
|||
|
||||
#if !__GNUC__ || !_POSIX_SOURCE
|
||||
#include "gc.mes.h"
|
||||
#include "hash.mes.h"
|
||||
#include "lib.mes.h"
|
||||
#include "math.mes.h"
|
||||
#include "mes.mes.h"
|
||||
|
|
@ -289,6 +290,7 @@ int g_function = 0;
|
|||
#include "vector.mes.h"
|
||||
#else
|
||||
#include "gc.h"
|
||||
#include "hash.h"
|
||||
#include "lib.h"
|
||||
#include "math.h"
|
||||
#include "mes.h"
|
||||
|
|
@ -1619,6 +1621,7 @@ mes_g_stack (SCM a) ///((internal))
|
|||
|
||||
// Environment setup
|
||||
|
||||
#include "hash.c"
|
||||
#include "module.c"
|
||||
#include "posix.c"
|
||||
#include "math.c"
|
||||
|
|
@ -2229,6 +2232,7 @@ a = acons (lookup_symbol_ (scm_getenv_.string), cell_getenv_, a);
|
|||
#include "mes.mes.i"
|
||||
|
||||
// Do not sort: Order of these includes define builtins
|
||||
#include "hash.mes.i"
|
||||
#include "module.mes.i"
|
||||
#include "posix.mes.i"
|
||||
#include "math.mes.i"
|
||||
|
|
@ -2239,6 +2243,7 @@ a = acons (lookup_symbol_ (scm_getenv_.string), cell_getenv_, a);
|
|||
#include "reader.mes.i"
|
||||
|
||||
#include "gc.mes.environment.i"
|
||||
#include "hash.mes.environment.i"
|
||||
#include "lib.mes.environment.i"
|
||||
#include "math.mes.environment.i"
|
||||
#include "mes.mes.environment.i"
|
||||
|
|
@ -2251,6 +2256,7 @@ a = acons (lookup_symbol_ (scm_getenv_.string), cell_getenv_, a);
|
|||
#include "mes.i"
|
||||
|
||||
// Do not sort: Order of these includes define builtins
|
||||
#include "hash.i"
|
||||
#include "module.i"
|
||||
#include "posix.i"
|
||||
#include "math.i"
|
||||
|
|
@ -2261,6 +2267,7 @@ a = acons (lookup_symbol_ (scm_getenv_.string), cell_getenv_, a);
|
|||
#include "reader.i"
|
||||
|
||||
#include "gc.environment.i"
|
||||
#include "hash.environment.i"
|
||||
#include "lib.environment.i"
|
||||
#include "math.environment.i"
|
||||
#include "mes.environment.i"
|
||||
|
|
|
|||
41
src/module.c
41
src/module.c
|
|
@ -18,11 +18,8 @@
|
|||
* along with GNU Mes. If not, see <http://www.gnu.org/licenses/>.
|
||||
*/
|
||||
|
||||
SCM make_vector__ (long k);
|
||||
SCM struct_ref_ (SCM x, long i);
|
||||
SCM struct_set_x_ (SCM x, long i, SCM e);
|
||||
SCM vector_ref_ (SCM x, long i);
|
||||
SCM vector_set_x_ (SCM x, long i, SCM e);
|
||||
|
||||
SCM
|
||||
make_initial_module (SCM a) ///((internal))
|
||||
|
|
@ -37,8 +34,7 @@ make_initial_module (SCM a) ///((internal))
|
|||
a = acons (module_type_name, module_type, a);
|
||||
SCM values = cell_nil;
|
||||
SCM name = cons (cstring_to_symbol ("boot"), cell_nil);
|
||||
//SCM globals = make_vector__ (28 * 27);
|
||||
SCM globals = make_vector__ (30 * 27);
|
||||
SCM globals = make_hash_table_ (0);
|
||||
values = cons (globals, values);
|
||||
SCM locals = cell_nil;
|
||||
values = cons (locals, values);
|
||||
|
|
@ -89,28 +85,6 @@ module_printer (SCM module)
|
|||
eputc ('>');
|
||||
}
|
||||
|
||||
|
||||
|
||||
int
|
||||
char_hash (int c)
|
||||
{
|
||||
if (c >= 'a' && c <= 'z')
|
||||
return c - 'a';
|
||||
return 27;
|
||||
}
|
||||
|
||||
int
|
||||
module_hash (SCM x) ///((internal))
|
||||
{
|
||||
int hash = char_hash (VALUE (CAR (STRING (x)))) * 27;
|
||||
if (TYPE (CDR (STRING (x))) == TPAIR)
|
||||
hash = hash + char_hash (VALUE (CADR (STRING (x))));
|
||||
else
|
||||
hash = hash + char_hash (0);
|
||||
assert (hash <= 756);
|
||||
return hash;
|
||||
}
|
||||
|
||||
SCM
|
||||
module_variable (SCM module, SCM name)
|
||||
{
|
||||
|
|
@ -119,12 +93,9 @@ module_variable (SCM module, SCM name)
|
|||
SCM x = assq (name, locals);
|
||||
if (x == cell_f)
|
||||
{
|
||||
int hash = module_hash (name);
|
||||
module = m0;
|
||||
SCM globals = struct_ref_ (module, 4);
|
||||
SCM bucket = vector_ref_ (globals, hash);
|
||||
if (TYPE (bucket) == TPAIR)
|
||||
x = assq (name, bucket);
|
||||
x = hashq_ref (globals, name, cell_f);
|
||||
}
|
||||
return x;
|
||||
}
|
||||
|
|
@ -149,13 +120,7 @@ module_define_x (SCM module, SCM name, SCM value)
|
|||
{
|
||||
eputs ("module_define_x: "); display_error_ (name); eputs ("\n");
|
||||
}
|
||||
int hash = module_hash (name);
|
||||
module = m0;
|
||||
SCM globals = struct_ref_ (module, 4);
|
||||
SCM bucket = vector_ref_ (globals, hash);
|
||||
if (TYPE (bucket) != TPAIR)
|
||||
bucket = cell_nil;
|
||||
bucket = acons (name, value, bucket);
|
||||
vector_set_x_ (globals, hash, bucket);
|
||||
return cell_t;
|
||||
return hashq_set_x (globals, name, value);
|
||||
}
|
||||
|
|
|
|||
Loading…
Reference in New Issue