From 3b752d4ef61b388553f73e2debcd733004a7cb33 Mon Sep 17 00:00:00 2001
From: Jan Nieuwenhuizen <janneke@gnu.org>
Date: Thu, 14 Nov 2019 09:50:52 +0100
Subject: [PATCH] core: Add lookup_variable_, lookup_variable, lookup_ref.

* src/variable.c (lookup_variable, lookup_ref): New builtins, and
(lookup_variable_): New function.
* include/mes/builtins.h: Declare them.
* include/mes/mes.h: Declare it.
* src/builtins.c (mes_builtins): Register them.
---
 include/mes/builtins.h |  2 ++
 include/mes/mes.h      |  1 +
 src/builtins.c         |  2 ++
 src/variable.c         | 32 ++++++++++++++++++++++++++++++++
 4 files changed, 37 insertions(+)

diff --git a/include/mes/builtins.h b/include/mes/builtins.h
index 9b21b641..96a61efe 100644
--- a/include/mes/builtins.h
+++ b/include/mes/builtins.h
@@ -178,6 +178,8 @@ struct scm *struct_set_x (struct scm *x, struct scm *i, struct scm *e);
 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);
+struct scm *lookup_variable (struct scm *lookup, struct scm *name, struct scm *define_p);
+struct scm *lookup_ref (struct scm *lookup, struct scm *name);
 /* src/vector.c */
 struct scm *make_vector (struct scm *x);
 struct scm *vector_length (struct scm *x);
diff --git a/include/mes/mes.h b/include/mes/mes.h
index 9836b906..f13e6bcf 100644
--- a/include/mes/mes.h
+++ b/include/mes/mes.h
@@ -127,6 +127,7 @@ struct scm *cell_ref (struct scm *cell, long index);
 struct scm *fdisplay_ (struct scm *, int, int);
 struct scm *init_symbols ();
 struct scm *init_time (struct scm *a);
+struct scm *lookup_variable_ (struct scm *lookup, char const* name);
 struct scm *make_builtin_type ();
 struct scm *make_bytes (char const *s, size_t length);
 struct scm *make_cell (long type, struct scm *car, struct scm *cdr);
diff --git a/src/builtins.c b/src/builtins.c
index 2010f320..fcf7cdb7 100644
--- a/src/builtins.c
+++ b/src/builtins.c
@@ -288,6 +288,8 @@ mes_builtins (struct scm *a)            /*:((internal)) */
   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);
+  a = init_builtin (builtin_type, "lookup-variable", 3, &lookup_variable, a);
+  a = init_builtin (builtin_type, "lookup-ref", 2, &lookup_ref, 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);
diff --git a/src/variable.c b/src/variable.c
index 39879076..e3755e77 100644
--- a/src/variable.c
+++ b/src/variable.c
@@ -48,3 +48,35 @@ variable_bound_p (struct scm *var)
     return cell_t;
   return cell_f;
 }
+
+struct scm *
+lookup_variable (struct scm *lookup, struct scm *name, struct scm *define_p)
+{
+  struct scm *handle = cell_f;
+  if (lookup->type = TPAIR)
+    handle = assq (name, lookup);
+
+  if (handle == cell_f)
+    {
+      handle = hashq_get_handle_ (M0, name, cell_f);
+      if (handle == cell_f && define_p == cell_t)
+        handle = hashq_set_handle_x (M0, name, cell_f);
+    }
+
+  return handle;
+}
+
+struct scm *
+lookup_variable_ (struct scm *lookup, char const* name)
+{
+  return lookup_variable (lookup, cstring_to_symbol (name), cell_f);
+}
+
+struct scm *
+lookup_ref (struct scm *lookup, struct scm *name)
+{
+  struct scm *x = lookup_variable (lookup, name, cell_f);
+  if (x == cell_f)
+    error (cell_symbol_unbound_variable, name);
+  return x->cdr;
+}