From e97d99c03a51ea8597fd4561c011dae58f5f57a4 Mon Sep 17 00:00:00 2001
From: Jan Nieuwenhuizen <janneke@gnu.org>
Date: Tue, 20 Dec 2016 20:10:43 +0100
Subject: [PATCH] Add ash.

* math.c (ash): New function.
* tests/scm.test (ash, ash -1): New tests.
---
 math.c         | 10 ++++++++++
 tests/scm.test |  4 ++++
 2 files changed, 14 insertions(+)

diff --git a/math.c b/math.c
index 8a9c023b..e1fbf006 100644
--- a/math.c
+++ b/math.c
@@ -143,3 +143,13 @@ logior (SCM x) ///((arity . n))
     }
   return make_number (n);
 }
+
+SCM
+ash (SCM n, SCM count)
+{
+  assert (TYPE (n) == NUMBER);
+  assert (TYPE (count) == NUMBER);
+  int cn = VALUE (n);
+  int ccount = VALUE (count);
+  return make_number ((ccount < 0) ? cn >> -ccount : cn << ccount);
+}
diff --git a/tests/scm.test b/tests/scm.test
index 955b3c5a..c936b367 100755
--- a/tests/scm.test
+++ b/tests/scm.test
@@ -60,6 +60,10 @@ exit $?
 (pass-if "modulo" (seq? (modulo 11 3) 2))
 (pass-if "expt" (seq? (expt 2 3) 8))
 (pass-if "logior" (seq? (logior 0 1 2 4) 7))
+(pass-if-equal "ash"
+    8 (ash 1 3))
+(pass-if-equal "ash -1"
+    5 (ash 10 -1))
 
 (pass-if "=" (seq? 3 '3))
 (pass-if "= 2" (not (= 3 '4)))