core: Implement Guile-style variables.
* src/variable.c: New file. * simple.make (LIBMES_SOURCES): Add it. * build-aux/configure-lib.sh (mes_SOURCES): Add it. * build-aux/snarf.sh: Snarf it. * kaem.run: Compile it. * include/mes/builtins.h (make_variable): New function. (variable_p): New function. (variable_ref): New function. (variable_set_x): New function. (variable_printer): New function. * src/builtins.c (mes_builtins): Register them. * include/mes/mes.h (make_variable_type): New function. (scm_variable_type): New variable. * src/module.c (make_initial_module): Initialize it. * src/gc.c (gc_flip, gc_): Keep track of it. * include/mes/symbols.h (cell_symbol_variable): New variable. (SYMBOL_MAX): Adjust accordingly. * src/symbol.c (init_symbols): Initialize 'cell_symbol_variable'. * mes/module/mes/scm.mes (make-undefined-variable): New procedure. (variable-bound?): New procedure. * tests/variable.test: New file. * build-aux/check-mes.sh (TESTS): Add it.
This commit is contained in:
parent
c317e939b9
commit
5edef591b7
|
@ -39,6 +39,7 @@ tests/cwv.test
|
|||
tests/math.test
|
||||
tests/vector.test
|
||||
tests/hash.test
|
||||
tests/variable.test
|
||||
tests/srfi-1.test
|
||||
tests/srfi-9.test
|
||||
tests/srfi-13.test
|
||||
|
|
|
@ -451,5 +451,6 @@ src/stack.c
|
|||
src/string.c
|
||||
src/struct.c
|
||||
src/symbol.c
|
||||
src/variable.c
|
||||
src/vector.c
|
||||
"
|
||||
|
|
|
@ -40,6 +40,7 @@ trace "SNARF$snarf stack.c" ${srcdest}build-aux/mes-snarf.scm src/stack.c
|
|||
trace "SNARF$snarf strings.c" ${srcdest}build-aux/mes-snarf.scm src/string.c
|
||||
trace "SNARF$snarf struct.c" ${srcdest}build-aux/mes-snarf.scm src/struct.c
|
||||
trace "SNARF$snarf symbol.c" ${srcdest}build-aux/mes-snarf.scm src/symbol.c
|
||||
trace "SNARF$snarf variable.c" ${srcdest}build-aux/mes-snarf.scm src/variable.c
|
||||
trace "SNARF$snarf vector.c" ${srcdest}build-aux/mes-snarf.scm src/vector.c
|
||||
|
||||
for i in src/*.symbols.h; do
|
||||
|
|
|
@ -174,6 +174,12 @@ struct scm *make_struct (struct scm *type, struct scm *fields, struct scm *print
|
|||
struct scm *struct_length (struct scm *x);
|
||||
struct scm *struct_ref (struct scm *x, struct scm *i);
|
||||
struct scm *struct_set_x (struct scm *x, struct scm *i, struct scm *e);
|
||||
/* src/variable.c */
|
||||
struct scm *make_variable (struct scm *var);
|
||||
struct scm *variable_p (struct scm *x);
|
||||
struct scm *variable_ref (struct scm *var);
|
||||
struct scm *variable_set_x (struct scm *var, struct scm *value);
|
||||
struct scm *variable_printer (struct scm *var);
|
||||
/* src/vector.c */
|
||||
struct scm *make_vector (struct scm *x);
|
||||
struct scm *vector_length (struct scm *x);
|
||||
|
|
|
@ -109,6 +109,7 @@ extern struct timeval *__gettimeofday_time;
|
|||
extern struct timespec *__get_internal_run_time_ts;
|
||||
|
||||
extern struct scm *scm_hash_table_type;
|
||||
extern struct scm *scm_variable_type;
|
||||
|
||||
struct scm *cast_charp_to_scmp (char const *i);
|
||||
struct scm **cast_charp_to_scmpp (char const *i);
|
||||
|
@ -148,6 +149,7 @@ struct scm *make_ref (struct scm *x);
|
|||
struct scm *make_string (char const *s, size_t length);
|
||||
struct scm *make_string0 (char const *s);
|
||||
struct scm *make_string_port (struct scm *x);
|
||||
struct scm *make_variable_type ();
|
||||
struct scm *make_vector_ (long k, struct scm *e);
|
||||
struct scm *mes_builtins (struct scm *a);
|
||||
struct scm *push_cc (struct scm *p1, struct scm *p2, struct scm *a, struct scm *c);
|
||||
|
|
|
@ -114,6 +114,7 @@ extern struct scm *cell_symbol_compiler;
|
|||
extern struct scm *cell_symbol_arch;
|
||||
extern struct scm *cell_symbol_pmatch_car;
|
||||
extern struct scm *cell_symbol_pmatch_cdr;
|
||||
extern struct scm *cell_symbol_variable;
|
||||
extern struct scm *cell_type_bytes;
|
||||
extern struct scm *cell_type_char;
|
||||
extern struct scm *cell_type_closure;
|
||||
|
@ -136,8 +137,8 @@ extern struct scm *cell_type_broken_heart;
|
|||
extern struct scm *cell_symbol_program;
|
||||
extern struct scm *cell_symbol_test;
|
||||
|
||||
// CONSTANT SYMBOL_MAX 114
|
||||
#define SYMBOL_MAX 114
|
||||
// CONSTANT SYMBOL_MAX 115
|
||||
#define SYMBOL_MAX 115
|
||||
|
||||
// CONSTANT CELL_UNSPECIFIED 7
|
||||
#define CELL_UNSPECIFIED 7
|
||||
|
|
1
kaem.run
1
kaem.run
|
@ -110,6 +110,7 @@ M2-Planet \
|
|||
-f src/string.c \
|
||||
-f src/struct.c \
|
||||
-f src/symbol.c \
|
||||
-f src/variable.c \
|
||||
-f src/vector.c \
|
||||
-o m2/mes.M1
|
||||
|
||||
|
|
|
@ -223,6 +223,15 @@
|
|||
;;(hash-fold (lambda (key value x) (proc key value)) #f table)
|
||||
*unspecified*)
|
||||
|
||||
|
||||
;; Variable
|
||||
(define (make-undefined-variable)
|
||||
(make-variable *undefined*))
|
||||
|
||||
;; This should be 'variable-defined?', but this is Guile's name.
|
||||
(define (variable-bound? var)
|
||||
(not (eq? (variable-ref var) *undefined*)))
|
||||
|
||||
|
||||
;; Vector
|
||||
(define (vector . rest) (list->vector rest))
|
||||
|
|
|
@ -62,6 +62,7 @@ LIBMES_SOURCES = \
|
|||
src/stack.c \
|
||||
src/struct.c \
|
||||
src/symbol.c \
|
||||
src/variable.c \
|
||||
src/vector.c
|
||||
|
||||
MES_SOURCES = \
|
||||
|
|
|
@ -284,6 +284,12 @@ mes_builtins (struct scm *a) /*:((internal)) */
|
|||
a = init_builtin (builtin_type, "struct-length", 1, &struct_length, a);
|
||||
a = init_builtin (builtin_type, "struct-ref", 2, &struct_ref, a);
|
||||
a = init_builtin (builtin_type, "struct-set!", 3, &struct_set_x, a);
|
||||
/* src/variable.c */
|
||||
a = init_builtin (builtin_type, "make-variable", 1, &make_variable, a);
|
||||
a = init_builtin (builtin_type, "variable?", 1, &variable_p, a);
|
||||
a = init_builtin (builtin_type, "variable-ref", 1, &variable_ref, a);
|
||||
a = init_builtin (builtin_type, "variable-set!", 2, &variable_set_x, a);
|
||||
a = init_builtin (builtin_type, "variable-printer", 1, &variable_printer, a);
|
||||
/* src/vector.c */
|
||||
a = init_builtin (builtin_type, "make-vector", -1, &make_vector, a);
|
||||
a = init_builtin (builtin_type, "vector-length", 1, &vector_length, a);
|
||||
|
|
2
src/gc.c
2
src/gc.c
|
@ -474,6 +474,7 @@ gc_flip ()
|
|||
g_macros = g_macros - dist;
|
||||
g_ports = g_ports - dist;
|
||||
scm_hash_table_type = scm_hash_table_type - dist;
|
||||
scm_variable_type = scm_variable_type - dist;
|
||||
M0 = M0 - dist;
|
||||
|
||||
long i;
|
||||
|
@ -646,6 +647,7 @@ gc_ ()
|
|||
g_macros = gc_copy (g_macros);
|
||||
g_ports = gc_copy (g_ports);
|
||||
scm_hash_table_type = gc_copy (scm_hash_table_type);
|
||||
scm_variable_type = gc_copy (scm_variable_type);
|
||||
M0 = gc_copy (M0);
|
||||
|
||||
long i;
|
||||
|
|
|
@ -42,6 +42,10 @@ make_initial_module (struct scm *a) /*:((internal)) */
|
|||
struct scm *hash_table_type = scm_hash_table_type;
|
||||
a = acons (cell_symbol_hashq_table, hash_table_type, a);
|
||||
|
||||
make_variable_type ();
|
||||
struct scm *variable_type = scm_variable_type;
|
||||
a = acons (cell_symbol_variable, variable_type, a);
|
||||
|
||||
struct scm *name = cons (cstring_to_symbol ("boot"), cell_nil);
|
||||
struct scm *globals = make_hash_table_ (0);
|
||||
struct scm *locals = cell_nil;
|
||||
|
|
|
@ -149,6 +149,7 @@ init_symbols_ () /*:((internal)) */
|
|||
cell_symbol_arch = init_symbol (g_symbol, TSYMBOL, "%arch");
|
||||
cell_symbol_pmatch_car = init_symbol (g_symbol, TSYMBOL, "pmatch-car");
|
||||
cell_symbol_pmatch_cdr = init_symbol (g_symbol, TSYMBOL, "pmatch-cdr");
|
||||
cell_symbol_variable = init_symbol (g_symbol, TSYMBOL, "<variable>");
|
||||
|
||||
cell_type_bytes = init_symbol (g_symbol, TSYMBOL, "<cell:bytes>");
|
||||
cell_type_char = init_symbol (g_symbol, TSYMBOL, "<cell:char>");
|
||||
|
|
|
@ -0,0 +1,78 @@
|
|||
/* -*-comment-start: "//";comment-end:""-*-
|
||||
* GNU Mes --- Maxwell Equations of Software
|
||||
* Copyright © Timothy Sample <samplet@ngyro.com>
|
||||
*
|
||||
* 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/>.
|
||||
*/
|
||||
|
||||
#include "mes/lib.h"
|
||||
#include "mes/mes.h"
|
||||
|
||||
struct scm *
|
||||
make_variable_type () /*:((internal)) */
|
||||
{
|
||||
if (scm_variable_type == 0)
|
||||
{
|
||||
struct scm *record_type = cell_symbol_record_type;
|
||||
struct scm *fields = cell_nil;
|
||||
fields = cons (cstring_to_symbol ("value"), fields);
|
||||
fields = cons (fields, cell_nil);
|
||||
fields = cons (cell_symbol_variable, fields);
|
||||
scm_variable_type = make_struct (record_type, fields, cell_unspecified);
|
||||
}
|
||||
return scm_variable_type;
|
||||
}
|
||||
|
||||
struct scm *
|
||||
make_variable (struct scm *value)
|
||||
{
|
||||
struct scm *type = make_variable_type ();
|
||||
struct scm *values = cell_nil;
|
||||
values = cons (value, values);
|
||||
values = cons (cell_symbol_variable, values);
|
||||
return make_struct (type, values, cstring_to_symbol ("variable-printer"));
|
||||
}
|
||||
|
||||
struct scm *
|
||||
variable_p (struct scm *x)
|
||||
{
|
||||
struct scm *type = make_variable_type ();
|
||||
if (x->type == TSTRUCT)
|
||||
if (struct_ref_ (x, 0) == type)
|
||||
return cell_t;
|
||||
return cell_f;
|
||||
}
|
||||
|
||||
struct scm *
|
||||
variable_ref (struct scm *var)
|
||||
{
|
||||
return struct_ref_ (var, 3);
|
||||
}
|
||||
|
||||
struct scm *
|
||||
variable_set_x (struct scm *var, struct scm *val)
|
||||
{
|
||||
return struct_set_x_ (var, 3, val);
|
||||
}
|
||||
|
||||
struct scm *
|
||||
variable_printer (struct scm *var)
|
||||
{
|
||||
fdputs ("#<variable ", __stdout);
|
||||
display_ (variable_ref (var));
|
||||
fdputc ('>', __stdout);
|
||||
return cell_unspecified;
|
||||
}
|
|
@ -0,0 +1,56 @@
|
|||
#! /bin/sh
|
||||
# -*-scheme-*-
|
||||
exec ${MES-bin/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests variable)' -s "$0" "$@"
|
||||
!#
|
||||
|
||||
;;; -*-scheme-*-
|
||||
|
||||
;;; GNU Mes --- Maxwell Equations of Software
|
||||
;;; Copyright © 2022 Timothy Sample <samplet@ngyro.com>
|
||||
;;;
|
||||
;;; 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 <https://www.gnu.org/licenses/>.
|
||||
|
||||
(define-module (tests variable)
|
||||
#:use-module (mes test))
|
||||
|
||||
(cond-expand
|
||||
(mes
|
||||
(mes-use-module (mes test)))
|
||||
(else))
|
||||
|
||||
(pass-if "make-variable and variable-ref"
|
||||
(let* ((x (cons 'foo '()))
|
||||
(v (make-variable x)))
|
||||
(eq? x (variable-ref v))))
|
||||
|
||||
(pass-if "variable-set!"
|
||||
(let ((v (make-variable 'foo)))
|
||||
(variable-set! v 'bar)
|
||||
(eq? 'bar (variable-ref v))))
|
||||
|
||||
(pass-if "make-undefined-variable and variable-bound?"
|
||||
(let ((bound (make-variable #t))
|
||||
(unbound (make-undefined-variable)))
|
||||
(and (variable-bound? bound)
|
||||
(not (variable-bound? unbound)))))
|
||||
|
||||
(pass-if "bind an unbound variable"
|
||||
(let ((v (make-undefined-variable)))
|
||||
(and (not (variable-bound? v))
|
||||
(begin (variable-set! v #t)
|
||||
(variable-bound? v)))))
|
||||
|
||||
(result 'report)
|
Loading…
Reference in New Issue