diff --git a/test/math-fail.rkt b/test/math-fail.rkt index f6a0e91..6ffe107 100644 --- a/test/math-fail.rkt +++ b/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) diff --git a/test/math-pass.rkt b/test/math-pass.rkt index 9419e36..26204a8 100644 --- a/test/math-pass.rkt +++ b/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) ) diff --git a/trivial/math.rkt b/trivial/math.rkt index bd28db3..1c5e8e6 100644 --- a/trivial/math.rkt +++ b/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:)) diff --git a/trivial/math/no-colon.rkt b/trivial/math/no-colon.rkt index 911208b..07a353b 100644 --- a/trivial/math/no-colon.rkt +++ b/trivial/math/no-colon.rkt @@ -8,4 +8,5 @@ [*: *] [/: /] [expt: expt] + [quotient: quotient] )) diff --git a/trivial/private/math.rkt b/trivial/private/math.rkt index a4f04ea..3ab8c82 100644 --- a/trivial/private/math.rkt +++ b/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]))))