core: variable: Guile interface compliancy. WIP

* src/lib.c (assert_variable):
* src/gc.c (make_variable): Move from
* src/eval-apply.c (make_variable): here; Remove.
* include/mes/builtins.h: Update.
* src/builtins.c (mes_builtins): Update.
* mes/module/mes/scm.mes (make-undefined-variable): New function.
* src/variable.c: New file.
* build-aux/configure-lib.sh (mes_SOURCES): Add it.
* kaem.run: Likewise.
* simple.make (LIBMES_SOURCES): Likewise.
* build-aux/snarf.sh (srcdest): Likewise.

build-aux/configure-lib.sh

@@ -449,5 +449,6 @@ src/stack.c
 src/string.c
 src/struct.c
 src/symbol.c
+src/variable.c
 src/vector.c
 "

build-aux/snarf.sh

@@ -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

include/mes/builtins.h

@@ -58,6 +58,7 @@ struct scm *add_formals (struct scm *formals, struct scm *x);
 struct scm *eval_apply ();
 /* src/gc.c */
 struct scm *cons (struct scm *x, struct scm *y);
+struct scm *make_variable (struct scm *var);
 struct scm *gc_check ();
 struct scm *gc ();
 /* src/hash.c */
@@ -169,6 +170,10 @@ 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 *variable_ref (struct scm *var);
+struct scm *variable_set_x (struct scm *var, struct scm *value);
+struct scm *variable_bound_p (struct scm *var);
 /* src/vector.c */
 struct scm *make_vector (struct scm *x);
 struct scm *vector_length (struct scm *x);

include/mes/mes.h

@@ -160,6 +160,7 @@ size_t bytes_cells (size_t length);
 void assert_max_string (size_t i, char const *msg, char const *string);
 void assert_msg (int check, char *msg);
 void assert_number (char const *name, struct scm *x);
+void assert_variable (long pos, struct scm *x);
 void copy_cell (struct scm *to, struct scm *from);
 void gc_ ();
 void gc_dump_arena (struct scm *cells, long size);

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
 

mes/module/mes/scm.mes

@@ -202,6 +202,11 @@
 (define (hash-ref table key . rest)
   (core:hash-ref table key (and (pair? rest) (car rest))))
 
+
+;; Variable
+(define (make-undefined-variable)
+  (make-variable *undefined*))
+
 
 ;; Vector
 (define (vector . rest) (list->vector rest))

simple.make

@@ -62,6 +62,7 @@ LIBMES_SOURCES =				\
  src/stack.c					\
  src/struct.c					\
  src/symbol.c					\
+ src/variable.c					\
  src/vector.c
 
 MES_SOURCES =					\

src/builtins.c

@@ -168,6 +168,7 @@ mes_builtins (struct scm *a)            /*:((internal)) */
   a = init_builtin (builtin_type, "eval-apply", 0, &eval_apply, a);
   /* src/gc.c */
   a = init_builtin (builtin_type, "cons", 2, &cons, a);
+  a = init_builtin (builtin_type, "make-variable", 1, &make_variable, a);
   a = init_builtin (builtin_type, "gc-check", 0, &gc_check, a);
   a = init_builtin (builtin_type, "gc", 0, &gc, a);
   /* src/hash.c */
@@ -279,6 +280,10 @@ 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, "variable-ref", 1, &variable_ref, a);
+  a = init_builtin (builtin_type, "variable-set!", 2, &variable_set_x, a);
+  a = init_builtin (builtin_type, "variable-bound?", 1, &variable_bound_p, 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);

src/eval-apply.c

@@ -148,12 +148,6 @@ make_closure_ (struct scm *args, struct scm *body, struct scm *a)       /*:((int
   return make_cell (TCLOSURE, cell_f, cons (cons (cell_circular, a), cons (args, body)));
 }
 
-struct scm *
-make_variable_ (struct scm *var)        /*:((internal)) */
-{
-  return make_cell (TVARIABLE, var, 0);
-}
-
 struct scm *
 macro_get_handle (struct scm *name)     /*:((internal)) */
 {
@@ -277,7 +271,7 @@ expand_variable_ (struct scm *x, struct scm *formals, int top_p)        /*:((int
             {
               v = module_variable (R0, a);
               if (v != cell_f)
-                x->car = make_variable_ (v);
+                x->car = make_variable (v);
             }
         }
       x = x->cdr;

src/gc.c

@@ -298,6 +298,12 @@ make_string_port (struct scm *x)        /*:((internal)) */
   return make_pointer_cell (TPORT, -length__ (g_ports) - 2, x);
 }
 
+struct scm *
+make_variable (struct scm *var)
+{
+  return make_cell (TVARIABLE, var, 0);
+}
+
 void
 gc_init_news ()
 {

src/lib.c

@@ -216,3 +216,10 @@ assert_range (int assert, long i)
     error (cell_symbol_out_of_range, cons (cell_type_struct, cons (make_number (pos), cons (x, cell_nil))));
   */
 }
+
+void
+assert_variable (long pos, struct scm *x)
+{
+  if (x->type != TVARIABLE)
+    error (cell_symbol_wrong_type_arg, cons (cell_type_struct, cons (make_number (pos), x)));
+}

src/variable.c

@@ -0,0 +1,50 @@
+/* -*-comment-start: "//";comment-end:""-*-
+ * GNU Mes --- Maxwell Equations of Software
+ * Copyright © 2016,2017,2018,2019 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/>.
+ */
+
+#include "mes/lib.h"
+#include "mes/mes.h"
+
+struct scm *
+variable_ref (struct scm *var)
+{
+  assert_variable (1, var);
+  struct scm *value = var->variable;
+  if (value == cell_undefined)
+    error (cell_symbol_unbound_variable, var);
+  return value;
+}
+
+struct scm *
+variable_set_x (struct scm *var, struct scm *value)
+{
+  assert_variable (1, var);
+  var->variable = value;
+  return cell_unspecified;
+}
+
+struct scm *
+variable_bound_p (struct scm *var)
+{
+  assert_variable (1, var);
+  struct scm *value = var->variable;
+  if (value != cell_undefined)
+    return cell_t;
+  return cell_f;
+}