implement MOD and REM

ixmilia · Oct 26, 2023 · f899346 · f899346
1 parent 245779c
commit f899346
Show file tree

Hide file tree

Showing 3 changed files with 73 additions and 0 deletions.
diff --git a/src/IxMilia.Lisp.Test/runtime-tests.lisp b/src/IxMilia.Lisp.Test/runtime-tests.lisp
@@ -267,6 +267,21 @@
     (assert-equal 4 (/ 24 3 2) "//*")
     ; exponent
     (assert-equal 8 (expt 2 3) "expt/2")
+    ; modulo and remainder - examples taken from http://clhs.lisp.se/Body/f_mod_r.htm
+    (assert-equal -1 (rem -1 5) "rem1")
+    (assert-equal 4 (mod -1 5) "mod1")
+    (assert-equal 1 (mod 13 4) "mod2")
+    (assert-equal 1 (rem 13 4) "rem2")
+    (assert-equal 3 (mod -13 4) "mod3")
+    (assert-equal -1 (rem -13 4) "rem3")
+    (assert-equal -3 (mod 13 -4) "mod4")
+    (assert-equal 1 (rem 13 -4) "rem4")
+    (assert-equal -1 (mod -13 -4) "mod5")
+    (assert-equal -1 (rem -13 -4) "rem5")
+    (assert-equal 0.25 (mod 13.25 1) "mod6")
+    (assert-equal 0.25 (rem 13.25 1) "rem6")
+    (assert-equal 0.75 (mod -13.25 1) "mod7")
+    (assert-equal -0.25 (rem -13.25 1) "rem7")
 )
 
 (and (item-equality)

diff --git a/src/IxMilia.Lisp/LispDefaultContext.cs b/src/IxMilia.Lisp/LispDefaultContext.cs
@@ -2549,6 +2549,58 @@ public Task<LispObject> TwoArgumentSlash(LispHost host, LispExecutionState execu
             return Task.FromResult(host.Nil);
         }
 
+        [LispFunction("KERNEL:MOD/2")]
+        public Task<LispObject> TwoArgumentMod(LispHost host, LispExecutionState executionState, LispObject[] args, CancellationToken cancellationToken)
+        {
+            if (args.Length == 2)
+            {
+                if (args[0] is LispInteger ai && args[1] is LispInteger bi)
+                {
+                    var a = ai.Value;
+                    var b = bi.Value;
+                    var result = ((a % b) + b) % b;
+                    return Task.FromResult<LispObject>(new LispInteger(result));
+                }
+                else if (args[0] is LispSimpleNumber an && args[1] is LispSimpleNumber bn)
+                {
+                    var av = an.AsFloat().Value;
+                    var bv = bn.AsFloat().Value;
+                    var dv = av / bv;
+                    var floor = Math.Floor(dv);
+                    var diff = dv - floor;
+                    return Task.FromResult<LispObject>(new LispFloat(diff));
+                }
+            }
+
+            executionState.ReportError(new LispError("Expected exactly two simple numeric arguments"), insertPop: true);
+            return Task.FromResult(host.Nil);
+        }
+
+        [LispFunction("KERNEL:REM/2")]
+        public Task<LispObject> TwoArgumentRem(LispHost host, LispExecutionState executionState, LispObject[] args, CancellationToken cancellationToken)
+        {
+            if (args.Length == 2)
+            {
+                if (args[0] is LispInteger ai && args[1] is LispInteger bi)
+                {
+                    var x = Math.DivRem(ai.Value, bi.Value, out var remainder);
+                    return Task.FromResult<LispObject>(new LispInteger(remainder));
+                }
+                else if (args[0] is LispSimpleNumber an && args[1] is LispSimpleNumber bn)
+                {
+                    var av = an.AsFloat().Value;
+                    var bv = bn.AsFloat().Value;
+                    var dv = av / bv;
+                    var floor = Math.Truncate(dv);
+                    var diff = dv - floor;
+                    return Task.FromResult<LispObject>(new LispFloat(diff));
+                }
+            }
+
+            executionState.ReportError(new LispError("Expected exactly two simple numeric arguments"), insertPop: true);
+            return Task.FromResult(host.Nil);
+        }
+
         [LispFunction("KERNEL:PROCESS-LIST-FORWARD-REFERENCE")]
         public async Task<LispObject> ProcessListForwardReference(LispHost host, LispExecutionState executionState, LispObject[] args, CancellationToken cancellationToken)
         {

diff --git a/src/IxMilia.Lisp/init.lisp b/src/IxMilia.Lisp/init.lisp
@@ -253,6 +253,12 @@
           ((equal 1 (length values))    (/ 1 (car values)))
           (t                            (reduce #'kernel://2 values))))
 
+(defun mod (a b)
+    (kernel:mod/2 a b))
+
+(defun rem (a b)
+    (kernel:rem/2 a b))
+
 (defpackage :common-lisp-user
     (:use :common-lisp))
 (in-package :common-lisp-user)