check if unsigned numbers underflow

coalton-lang · Oct 20, 2023 · 42ef9e3 · 42ef9e3
1 parent d03d8cc
commit 42ef9e3
Showing 1 changed file with 50 additions and 1 deletion.
diff --git a/library/math/num.lisp b/library/math/num.lisp
@@ -161,6 +161,50 @@
 ;;; Num instances for integers
 ;;;
 
+(cl:defmacro %define-unsigned-handler (name bits)
+  `(cl:defun ,name (bits)
+     (cl:declare (type (unsigned-byte ,bits) bits))
+     (cl:ecase ,bits
+       (8 (cl:the (cl:unsigned-byte ,bits) 255))
+       (16 (cl:the (cl:unsigned-byte ,bits) 65535))
+       (32 (cl:the (cl:unsigned-byte ,bits) 4294967295))
+       (64 (cl:the (cl:unsigned-byte ,bits) 18446744073709551615)))))
+
+
+(%define-unsigned-handler %unsigned-8-bit-handler 8)
+(%define-unsigned-handler %unsigned-16-bit-handler 16)
+(%define-unsigned-handler %unsigned-32-bit-handler 32)
+(%define-unsigned-handler %unsigned-64-bit-handler 64)
+
+(cl:eval-when (:compile-toplevel :load-toplevel)
+  (cl:defmacro define-unsigned-num-underflow (type underflow-handler bits)
+    "Define a `Num' instance for Type which signals an error on underflow."
+    `(define-instance (Num ,type)
+       (define (+ a b)
+	 (lisp ,type (a b)
+	   (cl:cond ((cl:and (cl:minusp b) (cl:< a (cl:- b)))
+		     (cl:cerror "Continue, wrapping around." ,(cl:format cl:nil "Unsigned value underflowed ~D bits." bits))
+		     (,underflow-handler ,bits))
+		    (cl:+ a b))))
+
+	 (define (- a b)
+	   (lisp ,type (a b)
+	     (cl:cond ((cl:< a (cl:+ 0 b))
+		       (cl:cerror "Continue, wrapping around." ,(cl:format cl:nil "Unsigned value underflowed ~D bits." bits))
+		       (,underflow-handler ,bits))
+		      (cl:- a b))))
+
+	 (define (* a b)
+	   (lisp ,type (a b)
+	     (cl:* a b)))
+
+	 (define (fromInt x)
+	   (lisp ,type (x)
+	     (cl:cond ((cl:< x 0)
+		       (cl:cerror "Continue, wrapping around." ,(cl:format cl:nil "Unsigned value underflowed ~D bits." bits))
+		       (,underflow-handler ,bits))
+		      (cl:t x)))))))    
+
 (cl:eval-when (:compile-toplevel :load-toplevel)
   (cl:defmacro define-num-checked (type overflow-handler)
     "Define a `Num' instance for TYPE which signals on overflow."
@@ -214,7 +258,12 @@
   (define-num-wrapping U16 16)
   (define-num-wrapping U32 32)
   (define-num-wrapping U64 64)
-  (define-num-wrapping UFix #.+unsigned-fixnum-bits+))
+  (define-num-wrapping UFix #.+unsigned-fixnum-bits+)
+
+  (define-unsigned-num-underflow U8 %unsigned-8-bit-handler 8)
+  (define-unsigned-num-underflow U16 %unsigned-16-bit-handler 16)
+  (define-unsigned-num-underflow U32 %unsigned-32-bit-handler 32)
+  (define-unsigned-num-underflow U64 %unsigned-64-bit-handler 64))
 
 ;;;
 ;;; Num instances for floats