[math] add quotient

test/math-fail.rkt

@@ -8,13 +8,14 @@
 
 (module+ test (test-compile-error
   #:require trivial/math
-  #:exn #rx"/:|Type Checker"
+  #:exn #rx"quotient:|/:|Type Checker"
   (ann (let ([n 2]) (+: n -2)) Zero)
   (ann (let ([n 2]) (-: 2 n)) Zero)
   (ann (let ([n 5]) (*: n 1/5 1)) One)
   (ann (let ([n 4]) (/: n n)) One)
   (ann (let ([n 2]) (expt: 3 (-: n n))) One)
   (ann (expt: 3 2) Zero)
+  (ann (quotient: 3 3) Zero)
   (ann ((lambda ([x : Natural]) (expt x 3)) 2) Index)
   ;; -- lambda => back to racket/base
   (ann ((lambda ([f : (-> Natural Natural Natural)]) (f 0 0)) +:) Zero)
@@ -25,6 +26,7 @@
   ;; -- dividing by zero => caught statically
   (/: 1 1 0)
   (/: 1 1 (+: 4 -2 -2))
+  (quotient: 9 0)
   ;; -- redefine ops => fail
   (ann (let ([+: (lambda (x y) "hello")]) (+: 1 1)) Integer)
   (ann (let ([-: (lambda (x y) "hello")]) (-: 1 1)) Integer)

test/math-pass.rkt

@@ -155,4 +155,12 @@
     (and (ann (lambda ([n : Natural]) (expt: n 0)) (-> Natural One)) #t))
   (check-true
     (and (ann (lambda ([n : Index]) (expt: n 1)) (-> Index Index)) #t))
+
+  ;; -- quotient
+  (check-equal?
+    (ann (quotient: 9 9) One)
+    1)
+  (check-equal?
+    (ann (quotient: (+ 99 99) (+ 32 1)) Index)
+    6)
 )

trivial/math.rkt

@@ -9,6 +9,7 @@
   ;;  but try to simplify arguments during expansion.
 
   expt:
+  quotient:
 
   define-num: let-num:
 
@@ -18,4 +19,4 @@
 (require
   trivial/private/set-bang
   (only-in trivial/private/math
-    +: -: *: /: expt: let-num: define-num:))
+    +: -: *: /: expt: quotient: let-num: define-num:))

trivial/math/no-colon.rkt

@@ -8,4 +8,5 @@
   [*: *]
   [/: /]
   [expt: expt]
+  [quotient: quotient]
 ))

trivial/private/math.rkt

@@ -9,6 +9,7 @@
   ;;  but try to simplify arguments during expansion.
 
   expt:
+  quotient:
 
   define-num: let-num:
 
@@ -127,3 +128,12 @@
        [else
         #f]))]
    [_ #f]))))
+
+(define-syntax quotient: (make-alias #'quotient
+  (lambda (stx) (syntax-parse stx
+    [(_ n1 n2)
+      (let ([v1 (stx->num #'n1)]
+            [v2 (stx->num #'n2)])
+        (and v1 v2
+          (quasisyntax/loc stx #,(quotient v1 v2))))]
+    [_ #f]))))