From 7932d4bad7cc2f332db80fce921e7cce934468ca Mon Sep 17 00:00:00 2001
From: "Jan (janneke) Nieuwenhuizen" <janneke@gnu.org>
Date: Mon, 18 May 2020 00:40:50 +0200
Subject: [PATCH] core: Remove core:make-cell.

* src/gc.c (alloc, make_cell, cons): Move from mes.c
* src/mes.c: (make_cell_): Remove.
* src/lib.c (char_to_integer, integer_to_char): New function.
* src/builtins.c (mes_builtins): Add them; remove make_cell_.
* mes/module/mes/type-0.mes (char->integer, integer->char): Remove.
---
 include/mes/builtins.h                   |  9 ++++-
 include/mes/m2.h                         | 12 +++----
 include/mes/macros.h                     | 12 +++----
 include/mes/mes.h                        |  2 +-
 mes/module/mes/type-0.mes                |  6 ----
 module/mes/guile.scm                     |  5 +--
 scaffold/boot/60-let-syntax-expanded.scm |  3 --
 src/builtins.c                           |  6 ++--
 src/eval-apply.c                         |  6 ++--
 src/gc.c                                 | 29 +++++++++++++++
 src/lib.c                                | 12 +++++++
 src/mes.c                                | 46 ------------------------
 src/string.c                             | 10 +++---
 src/struct.c                             |  2 +-
 src/vector.c                             |  2 +-
 15 files changed, 76 insertions(+), 86 deletions(-)

diff --git a/include/mes/builtins.h b/include/mes/builtins.h
index 0f0faff8..38ed1484 100644
--- a/include/mes/builtins.h
+++ b/include/mes/builtins.h
@@ -66,7 +66,9 @@ SCM memq (SCM x, SCM a);
 SCM equal2_p (SCM a, SCM b);
 SCM last_pair (SCM x);
 SCM pair_p (SCM x);
-/* src/math.c */
+SCM char_to_integer (SCM x);
+SCM integer_to_char (SCM x);
+/* src/math.mes */
 SCM greater_p (SCM x);
 SCM less_p (SCM x);
 SCM is_p (SCM x);
@@ -100,6 +102,11 @@ SCM append_reverse (SCM x, SCM y);
 SCM reverse_x_ (SCM x, SCM t);
 SCM assq (SCM x, SCM a);
 SCM assoc (SCM x, SCM a);
+SCM set_car_x (SCM x, SCM e);
+SCM set_cdr_x (SCM x, SCM e);
+SCM set_env_x (SCM x, SCM e, SCM a);
+SCM add_formals (SCM formals, SCM x);
+SCM eval_apply ();
 /* src/module.c */
 SCM make_module_type ();
 SCM module_printer (SCM module);
diff --git a/include/mes/m2.h b/include/mes/m2.h
index b469973f..812e40fd 100644
--- a/include/mes/m2.h
+++ b/include/mes/m2.h
@@ -93,13 +93,13 @@ struct timeval
 #define MAKE_BYTES0(x) make_bytes (x, strlen (x))
 #define NAME_SYMBOL(symbol,name) {size_t s = strlen (name); CAR (symbol) = s; CDR (symbol) = make_bytes (name, s);}
 
-#define MAKE_CHAR(n) make_cell__ (TCHAR, 0, n)
-#define MAKE_CONTINUATION(n) make_cell__ (TCONTINUATION, n, g_stack)
-#define MAKE_NUMBER(n) make_cell__ (TNUMBER, 0, n)
-#define MAKE_REF(n) make_cell__ (TREF, n, 0)
+#define MAKE_CHAR(n) make_cell (TCHAR, 0, n)
+#define MAKE_CONTINUATION(n) make_cell (TCONTINUATION, n, g_stack)
+#define MAKE_NUMBER(n) make_cell (TNUMBER, 0, n)
+#define MAKE_REF(n) make_cell (TREF, n, 0)
 #define MAKE_STRING0(x) make_string (x, strlen (x))
-#define MAKE_STRING_PORT(x) make_cell__ (TPORT, -length__ (g_ports) - 2, x)
-#define MAKE_MACRO(name, x) make_cell__ (TMACRO, x, STRING (name))
+#define MAKE_STRING_PORT(x) make_cell (TPORT, -length__ (g_ports) - 2, x)
+#define MAKE_MACRO(name, x) make_cell (TMACRO, x, STRING (name))
 
 #define CAAR(x) CAR (CAR (x))
 #define CADR(x) CAR (CDR (x))
diff --git a/include/mes/macros.h b/include/mes/macros.h
index 86dd0970..f2a816c2 100644
--- a/include/mes/macros.h
+++ b/include/mes/macros.h
@@ -61,13 +61,13 @@
 #define MAKE_BYTES0(x) make_bytes (x, strlen (x))
 #define NAME_SYMBOL(symbol,name) {size_t s = strlen (name); CAR (symbol) = s; CDR (symbol) = make_bytes (name, s);}
 
-#define MAKE_CHAR(n) make_cell__ (TCHAR, 0, n)
-#define MAKE_CONTINUATION(n) make_cell__ (TCONTINUATION, n, g_stack)
-#define MAKE_NUMBER(n) make_cell__ (TNUMBER, 0, (long)n)
-#define MAKE_REF(n) make_cell__ (TREF, n, 0)
+#define MAKE_CHAR(n) make_cell (TCHAR, 0, n)
+#define MAKE_CONTINUATION(n) make_cell (TCONTINUATION, n, g_stack)
+#define MAKE_NUMBER(n) make_cell (TNUMBER, 0, (long)n)
+#define MAKE_REF(n) make_cell (TREF, n, 0)
 #define MAKE_STRING0(x) make_string (x, strlen (x))
-#define MAKE_STRING_PORT(x) make_cell__ (TPORT, -length__ (g_ports) - 2, x)
-#define MAKE_MACRO(name, x) make_cell__ (TMACRO, x, STRING (name))
+#define MAKE_STRING_PORT(x) make_cell (TPORT, -length__ (g_ports) - 2, x)
+#define MAKE_MACRO(name, x) make_cell (TMACRO, x, STRING (name))
 
 #define CAAR(x) CAR (CAR (x))
 #define CADR(x) CAR (CDR (x))
diff --git a/include/mes/mes.h b/include/mes/mes.h
index 8ce6320f..e9788e99 100644
--- a/include/mes/mes.h
+++ b/include/mes/mes.h
@@ -90,7 +90,7 @@ SCM init_symbols ();
 SCM init_time (SCM a);
 SCM make_builtin_type ();
 SCM make_bytes (char const *s, size_t length);
-SCM make_cell__ (long type, SCM car, SCM cdr);
+SCM make_cell (long type, SCM car, SCM cdr);
 SCM make_hash_table_ (long size);
 SCM make_hashq_type ();
 SCM make_initial_module (SCM a);
diff --git a/mes/module/mes/type-0.mes b/mes/module/mes/type-0.mes
index e01e6e50..b966ba58 100644
--- a/mes/module/mes/type-0.mes
+++ b/mes/module/mes/type-0.mes
@@ -119,9 +119,3 @@
 
 (define (symbol->list s)
   (string->list (symbol->string s)))
-
-(define (integer->char x)
-  (core:make-cell <cell:char> 0 x))
-
-(define (char->integer x)
-  (core:make-cell <cell:number> 0 x))
diff --git a/module/mes/guile.scm b/module/mes/guile.scm
index 12307dcb..242561f9 100644
--- a/module/mes/guile.scm
+++ b/module/mes/guile.scm
@@ -42,7 +42,6 @@
             core:display-port
             core:exit
             core:macro-expand
-            core:make-cell
             core:write
             core:write-error
             core:write-port
@@ -105,9 +104,7 @@
           ((guile:string? x) <cell:string>)
           ((guile:symbol? x) <cell:symbol>)))
   (define (core:car x)
-    (cond ((guile:string? x) (string->list x))))
-  (define (core:make-cell type car cdr)
-    (cond ((eq? type <cell:string>) (list->string car)))))
+    (cond ((guile:string? x) (string->list x)))))
  (mes))
 
 (cond-expand
diff --git a/scaffold/boot/60-let-syntax-expanded.scm b/scaffold/boot/60-let-syntax-expanded.scm
index cfb229fb..a298a83f 100644
--- a/scaffold/boot/60-let-syntax-expanded.scm
+++ b/scaffold/boot/60-let-syntax-expanded.scm
@@ -46,9 +46,6 @@
   (if (null? rest) (core:write x)
       (core:write-port x (car rest))))
 
-(define (integer->char x)
-  (core:make-cell <cell:character> 0 x))
-
 (define (newline . rest)
   (core:display (list->string (list (integer->char 10)))))
 
diff --git a/src/builtins.c b/src/builtins.c
index f441e27d..6685d459 100644
--- a/src/builtins.c
+++ b/src/builtins.c
@@ -129,10 +129,10 @@ mes_builtins (SCM a)            /*:((internal)) */
   a = init_builtin (builtin_type, "set-car!", 2, &set_car_x, a);
   a = init_builtin (builtin_type, "set-cdr!", 2, &set_cdr_x, a);
   a = init_builtin (builtin_type, "set-env!", 3, &set_env_x, a);
-  a = init_builtin (builtin_type, "macro-get-handle", 1, &macro_get_handle, a);
   a = init_builtin (builtin_type, "add-formals", 2, &add_formals, a);
   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, "gc-check", 0, &gc_check, a);
   a = init_builtin (builtin_type, "gc", 0, &gc, a);
   /* src/hash.c */
@@ -156,6 +156,8 @@ mes_builtins (SCM a)            /*:((internal)) */
   a = init_builtin (builtin_type, "equal2?", 2, &equal2_p, a);
   a = init_builtin (builtin_type, "last-pair", 1, &last_pair, a);
   a = init_builtin (builtin_type, "pair?", 1, &pair_p, a);
+  a = init_builtin (builtin_type, "char->integer", 1, &char_to_integer, a);
+  a = init_builtin (builtin_type, "integer->char", 1, &integer_to_char, a);
   /* src/math.c */
   a = init_builtin (builtin_type, ">", -1, &greater_p, a);
   a = init_builtin (builtin_type, "<", -1, &less_p, a);
@@ -171,11 +173,9 @@ mes_builtins (SCM a)            /*:((internal)) */
   a = init_builtin (builtin_type, "logxor", -1, &logxor, a);
   a = init_builtin (builtin_type, "ash", 2, &ash, a);
   /* src/mes.c */
-  a = init_builtin (builtin_type, "core:make-cell", 3, &make_cell_, a);
   a = init_builtin (builtin_type, "core:type", 1, &type_, a);
   a = init_builtin (builtin_type, "core:car", 1, &car_, a);
   a = init_builtin (builtin_type, "core:cdr", 1, &cdr_, a);
-  a = init_builtin (builtin_type, "cons", 2, &cons, a);
   a = init_builtin (builtin_type, "car", 1, &car, a);
   a = init_builtin (builtin_type, "cdr", 1, &cdr, a);
   a = init_builtin (builtin_type, "list", -1, &list, a);
diff --git a/src/eval-apply.c b/src/eval-apply.c
index a5a9894d..5126b126 100644
--- a/src/eval-apply.c
+++ b/src/eval-apply.c
@@ -145,17 +145,17 @@ call_lambda (SCM e, SCM x, SCM aa, SCM a)       /*:((internal)) */
 SCM
 make_closure_ (SCM args, SCM body, SCM a)       /*:((internal)) */
 {
-  return make_cell__ (TCLOSURE, cell_f, cons (cons (cell_circular, a), cons (args, body)));
+  return make_cell (TCLOSURE, cell_f, cons (cons (cell_circular, a), cons (args, body)));
 }
 
 SCM
 make_variable_ (SCM var)        /*:((internal)) */
 {
-  return make_cell__ (TVARIABLE, var, 0);
+  return make_cell (TVARIABLE, var, 0);
 }
 
 SCM
-macro_get_handle (SCM name)
+macro_get_handle (SCM name)     /*:((internal)) */
 {
   if (TYPE (name) == TSYMBOL)
     return hashq_get_handle (g_macros, name, cell_nil);
diff --git a/src/gc.c b/src/gc.c
index 22f37026..3ca9fa2e 100644
--- a/src/gc.c
+++ b/src/gc.c
@@ -87,6 +87,35 @@ gc_init_news ()                 /*:((internal)) */
   return 0;
 }
 
+SCM
+alloc (long n)
+{
+  SCM x = g_free;
+  g_free = g_free + n;
+  if (g_free > ARENA_SIZE)
+    assert_msg (0, "alloc: out of memory");
+  return x;
+}
+
+SCM
+make_cell (long type, SCM car, SCM cdr)
+{
+  SCM x = g_free;
+  g_free = g_free + 1;
+  if (g_free > ARENA_SIZE)
+    assert_msg (0, "alloc: out of memory");
+  TYPE (x) = type;
+  CAR (x) = car;
+  CDR (x) = cdr;
+  return x;
+}
+
+SCM
+cons (SCM x, SCM y)
+{
+  return make_cell (TPAIR, x, y);
+}
+
 SCM
 gc_up_arena ()                  /*:((internal)) */
 {
diff --git a/src/lib.c b/src/lib.c
index b9fa9561..458767a6 100644
--- a/src/lib.c
+++ b/src/lib.c
@@ -202,3 +202,15 @@ pair_p (SCM x)
     return cell_t;
   return cell_f;
 }
+
+SCM
+char_to_integer (SCM x)
+{
+  return MAKE_NUMBER (VALUE (x));
+}
+
+SCM
+integer_to_char (SCM x)
+{
+  return MAKE_CHAR (VALUE (x));
+}
diff --git a/src/mes.c b/src/mes.c
index 35efe041..544c3d18 100644
--- a/src/mes.c
+++ b/src/mes.c
@@ -29,46 +29,6 @@
 
 // char const *MES_PKGDATADIR = "mes";
 
-SCM
-alloc (long n)
-{
-  SCM x = g_free;
-  g_free = g_free + n;
-  if (g_free > ARENA_SIZE)
-    assert_msg (0, "alloc: out of memory");
-  return x;
-}
-
-SCM
-make_cell__ (long type, SCM car, SCM cdr)
-{
-  SCM x = alloc (1);
-  TYPE (x) = type;
-  CAR (x) = car;
-  CDR (x) = cdr;
-  return x;
-}
-
-SCM
-make_cell_ (SCM type, SCM car, SCM cdr)
-{
-  assert_msg (TYPE (type) == TNUMBER, "TYPE (type) == TNUMBER");
-  long t = VALUE (type);
-  if (t == TCHAR || t == TNUMBER)
-    {
-      if (car != 0)
-        car = CAR (car);
-      else
-        car = 0;
-      if (cdr != 0)
-        cdr = CDR (cdr);
-      else
-        cdr = 0;
-      return make_cell__ (t, car, cdr);
-    }
-  return make_cell__ (t, car, cdr);
-}
-
 SCM
 assoc_string (SCM x, SCM a)     /*:((internal)) */
 {
@@ -109,12 +69,6 @@ cdr_ (SCM x)
   return MAKE_NUMBER (CDR (x));
 }
 
-SCM
-cons (SCM x, SCM y)
-{
-  return make_cell__ (TPAIR, x, y);
-}
-
 SCM
 car (SCM x)
 {
diff --git a/src/string.c b/src/string.c
index 70c38d03..4e6b91fe 100644
--- a/src/string.c
+++ b/src/string.c
@@ -90,7 +90,7 @@ make_string (char const *s, size_t length)
 {
   if (length > MAX_STRING)
     assert_max_string (length, "make_string", s);
-  SCM x = make_cell__ (TSTRING, length, 0);
+  SCM x = make_cell (TSTRING, length, 0);
   SCM v = make_bytes (s, length);
   CDR (x) = v;
   return x;
@@ -127,19 +127,19 @@ string_equal_p (SCM a, SCM b)   /*:((name . "string=?")) */
 SCM
 symbol_to_string (SCM symbol)
 {
-  return make_cell__ (TSTRING, CAR (symbol), CDR (symbol));
+  return make_cell (TSTRING, CAR (symbol), CDR (symbol));
 }
 
 SCM
 symbol_to_keyword (SCM symbol)
 {
-  return make_cell__ (TKEYWORD, CAR (symbol), CDR (symbol));
+  return make_cell (TKEYWORD, CAR (symbol), CDR (symbol));
 }
 
 SCM
 keyword_to_string (SCM keyword)
 {
-  return make_cell__ (TSTRING, CAR (keyword), CDR (keyword));
+  return make_cell (TSTRING, CAR (keyword), CDR (keyword));
 }
 
 SCM
@@ -154,7 +154,7 @@ string_to_symbol (SCM string)
 SCM
 make_symbol (SCM string)
 {
-  SCM x = make_cell__ (TSYMBOL, LENGTH (string), STRING (string));
+  SCM x = make_cell (TSYMBOL, LENGTH (string), STRING (string));
   hash_set_x (g_symbols, string, x);
   return x;
 }
diff --git a/src/struct.c b/src/struct.c
index 5398433d..81b1f922 100644
--- a/src/struct.c
+++ b/src/struct.c
@@ -26,7 +26,7 @@ make_struct (SCM type, SCM fields, SCM printer)
 {
   long size = 2 + length__ (fields);
   SCM v = alloc (size);
-  SCM x = make_cell__ (TSTRUCT, size, v);
+  SCM x = make_cell (TSTRUCT, size, v);
   SCM vt = vector_entry (type);
   TYPE (v) = TYPE (vt);
   CAR (v) = CAR (vt);
diff --git a/src/vector.c b/src/vector.c
index 0f69f2a6..17432258 100644
--- a/src/vector.c
+++ b/src/vector.c
@@ -25,7 +25,7 @@ SCM
 make_vector__ (long k)
 {
   SCM v = alloc (k);
-  SCM x = make_cell__ (TVECTOR, k, v);
+  SCM x = make_cell (TVECTOR, k, v);
   long i;
   for (i = 0; i < k; i = i + 1)
     g_cells[v + i] = g_cells[vector_entry (cell_unspecified)];